home *** CD-ROM | disk | FTP | other *** search
/ Software Vault: The Gold Collection / Software Vault - The Gold Collection (American Databankers) (1993).ISO / cdr47 / ucrasm27.zip / SOURCE.ZIP / FP.ASM < prev    next >
Assembly Source File  |  1992-06-19  |  83KB  |  3,663 lines

  1. ;
  2. StdGrp        group    StdLib, StdData
  3. ;
  4. StdData        segment    para public 'sldata'
  5. ;
  6. ; Floating point package.
  7. ;
  8. ;
  9. ; Released to the public domain
  10. ; Created by: Randall Hyde
  11. ; Date: 8/13/90
  12. ;    8/28/91
  13. ;
  14. ;
  15. ; FP format:
  16. ;
  17. ; 80 bits:
  18. ; bit 79            bit 63                           bit 0
  19. ; |                 |                                    |
  20. ; seeeeeee eeeeeeee mmmmmmmm m...m m...m m...m m...m m...m
  21. ;
  22. ; e = bias 16384 exponent
  23. ; m = 64 bit mantissa with NO implied bit!
  24. ; s = sign (for mantissa)
  25. ;
  26. ;
  27. ; 64 bits:
  28. ; bit 63       bit 51                                               bit 0
  29. ; |            |                                                        |
  30. ; seeeeeee eeeemmmm mmmmmmmm mmmmmmmm mmmmmmmm mmmmmmmm mmmmmmmm mmmmmmmm
  31. ;
  32. ; e = bias 1023 exponent.
  33. ; s = sign bit.
  34. ; m = mantissa bits.  Bit 52 is an implied one bit.
  35. ;
  36. ; 32 bits:
  37. ; Bit 31    Bit 22              Bit 0
  38. ; |         |                       |
  39. ; seeeeeee emmmmmmm mmmmmmmm mmmmmmmm
  40. ;
  41. ; e = bias 127 exponent
  42. ; s = sign bit
  43. ; m = mantissa bits, bit 23 is an implied one bit.
  44. ;
  45. ;
  46. ;
  47. ; WARNING: Although this package uses IEEE format floating point numbers,
  48. ;       it is by no means IEEE compliant.  In particular, it does not
  49. ;       support denormalized numbers, special rounding options, and
  50. ;       so on.  Why not?  Two reasons:  I'm lazy and I'm ignorant.
  51. ;       I do not know all the little details surround the IEEE
  52. ;       implementation and I'm not willing to spend more of my life
  53. ;       (than I already have) figuring it out.  There are more
  54. ;       important things to do in life.  Yep, numerical analysts can
  55. ;       rip this stuff to shreads and come up with all kinds of degenerate
  56. ;       cases where this package fails and the IEEE algorithms succeed,
  57. ;       however, such cases are very rare.  One should not get the idea
  58. ;       that IEEE is perfect.  It blows up with lots of degenerate cases
  59. ;       too.  They just designed it so that it handles a few additional
  60. ;       cases that mediocre packages (like this one) do not.  For most
  61. ;       normal computations this package works just fine (what it lacks
  62. ;       it good algorithms it more than makes up for by using an 88-bit
  63. ;       internal format during internal computations).
  64. ;
  65. ;       Moral of the story: If you need highly accurate routines which
  66. ;          produce okay results in the worst of cases, look elsewhere please.
  67. ;       I don't want to be responsible for your blowups.  OTOH, if you need
  68. ;       a fast floating point package which is reasonably accurate and
  69. ;       you're not a statistician, astronomer, or other type for whom
  70. ;       features like denormalized numbers are important, this package
  71. ;       may work out just fine for you.
  72. ;
  73. ;                        Randy Hyde
  74. ;                        August 1990
  75. ;                        (Hard to believe I started this
  76. ;                         a year ago and I'm just coming
  77. ;                         back to it now!)
  78. ;
  79. ;                        UC Riverside &
  80. ;                        Cal Poly Pomona.
  81. ;
  82. ; FPACC- Floating point accumuator.
  83. ; FPOP-  Floating point operand.
  84. ;
  85. ; These variables use the following format:
  86. ;
  87. ; 88 bits:
  88. ; sxxxxxxx eeeeeeee eeeeeeee m..m m..m m..m m..m m..m m..m m..m m..m
  89. ; Sign          exponent                   mantissa (64 bits)
  90. ;
  91. ; Only H.O. bit of Sign byte is significant.  The rest is garbage.
  92. ; Exponent is bias 32767 exponent.
  93. ; Mantissa does NOT have an implied one bit.
  94. ;
  95. ; This format was picked for convenience (it is easy to work with) and it
  96. ; exceeds the 80-bit format used by Intel on the 80x87 chips.
  97. ;
  98. fptype        struc
  99. Mantissa    dw    4 dup (?)
  100. Exponent    dw    ?
  101. Sign        db    ?
  102.         db    ?        ;Padding
  103. fptype        ends
  104. ;
  105. ;
  106. ;
  107. ;
  108.         public    fpacc
  109. fpacc        fptype    <>
  110. ;
  111.         public    fpop
  112. fpop        fptype  <>
  113. ;
  114. ;
  115. ; FProd- Holds 144-bit result obtained by multiplying fpacc.mant x fpop.mant
  116. ;
  117. Quotient    equ    this word
  118. fprod        dw    9 dup (?)
  119. ;
  120. ;
  121. ; Variables used by the floating point I/O routines:
  122. ;
  123. TempExp        dw    ?
  124. ExpSign        db    ?
  125. DecExponent    dw    ?
  126. DecSign        db    0
  127. DecDigits    db    31 dup (?)
  128. ;
  129. ;
  130. ;
  131. StdData        ends
  132. ;
  133. ;
  134. stdlib        segment    para public 'slcode'
  135.         assume    cs:stdgrp, ds:nothing, es:nothing, ss:nothing
  136. ;
  137. ;
  138. ;
  139. ;
  140. ;
  141. ;
  142. ;
  143. ;
  144. ;
  145. ;
  146. ;---------------------------------------------------------------------------
  147. ;        Floating Point Load/Store Routines
  148. ;---------------------------------------------------------------------------
  149. ;
  150. ; sl_AccOp    Copies the floating point accumulator to the floating point
  151. ;        operand.
  152. ;
  153.         public    sl_AccOp
  154. sl_AccOp    proc    far
  155.         assume    ds:StdGrp
  156.         push    ax
  157.         push    ds
  158.         mov    ax, StdGrp
  159.         mov    ds, ax
  160. ;
  161.         mov    ax, FPacc.Exponent
  162.         mov    FPop.Exponent, ax
  163.         mov    ax, FPacc.Mantissa
  164.         mov    FPop.Mantissa, ax
  165.         mov    ax, FPacc.Mantissa+2
  166.         mov    FPop.Mantissa+2, ax
  167.         mov    ax, FPacc.Mantissa+4
  168.         mov    FPop.Mantissa+4, ax
  169.         mov    ax, FPacc.Mantissa+6
  170.         mov    FPop.Mantissa+6, ax
  171.         mov    al, Fpacc.Sign
  172.         mov    FPop.Sign, al
  173. ;
  174.         pop    ds
  175.         pop    ax
  176.         ret
  177. sl_AccOp    endp
  178.         assume    ds:nothing
  179. ;
  180. ;
  181. ; sl_XAccOp-    Exchanges the values in the floating point accumulator
  182. ;        and floating point operand.
  183. ;
  184.         public    sl_XAccOp
  185. sl_XAccOp    proc    far
  186.         assume    ds:StdGrp
  187.         push    ax
  188.         push    ds
  189.         mov    ax, StdGrp
  190.         mov    ds, ax
  191. ;
  192.         mov    ax, FPacc.Exponent
  193.         xchg    ax, FPop.Exponent
  194.         mov    FPacc.Exponent, ax
  195. ;
  196.         mov    ax, FPacc.Mantissa
  197.         xchg    ax, FPop.Mantissa
  198.         mov    FPacc.Mantissa, ax
  199. ;
  200.         mov    ax, FPacc.Mantissa+2
  201.         xchg    ax, FPop.Mantissa+2
  202.         mov    FPacc.Mantissa+2, ax
  203. ;
  204.         mov    ax, FPacc.Mantissa+4
  205.         xchg    ax, FPop.Mantissa+4
  206.         mov    FPacc.Mantissa+4, ax
  207. ;
  208.         mov    ax, FPacc.Mantissa+6
  209.         xchg    ax, FPop.Mantissa+6
  210.         mov    FPacc.Mantissa+6, ax
  211. ;
  212.         mov    al, FPacc.Sign
  213.         xchg    al, FPop.Sign
  214.         mov    FPacc.Sign, al
  215. ;
  216.         pop    ds
  217.         pop    ax
  218.         ret
  219. sl_XAccOp    endp
  220.         assume    ds:nothing
  221. ;
  222. ;
  223. ;
  224. ; sl_LSFPA-     Loads a single precision (32-bit) IEEE format number into
  225. ;        the floating point accumulator.  ES:DI points at the # to
  226. ;        load into FPACC.
  227. ;
  228.         public    sl_LSFPA
  229. sl_LSFPA    proc    far
  230.         push    ax
  231.         push    bx
  232.         mov    ax, es:[di]
  233.         mov    word ptr StdGrp:fpacc.mantissa[5], ax
  234.         mov    ax, es:2[di]
  235.         mov    bx, ax
  236.         shl    ax, 1
  237.         mov    al, ah
  238.         mov    ah, 0
  239.         add    ax, 32767-127        ;Adjust exponent bias.
  240.         mov    word ptr StdGrp:fpacc.exponent, ax
  241.         mov    StdGrp:fpacc.sign, bh    ;Save sign away.
  242.         mov    al, es:2[di]
  243.         and    al, 7fh            ;Strip out L.O. exp bit.
  244.         or    al, 80h            ;Add in implied bit.
  245.         mov    byte ptr StdGrp:fpacc.mantissa[7], al ;Save H.O. mant byte.
  246.         xor    ax, ax
  247.         mov    word ptr StdGrp:fpacc.mantissa, ax
  248.         mov    word ptr StdGrp:fpacc.mantissa[2], ax
  249.         mov    byte ptr StdGrp:fpacc.mantissa[4], al
  250.         pop    bx
  251.         pop    ax
  252.         ret
  253. sl_LSFPA    endp
  254. ;
  255. ;
  256. ;
  257. ;
  258. ; sl_SSFPA-    Stores FPACC into the single precision variable pointed at by
  259. ;        ES:DI.  Performs appropriate rounding.  Returns carry clear
  260. ;        if the operation is successful, returns carry set if FPACC
  261. ;        cannot fit into a single precision variable.
  262. ;
  263.         public    sl_SSFPA
  264. sl_SSFPA    proc    far
  265.         assume    ds:stdgrp
  266.         push    ds
  267.         push    ax
  268.         push    bx
  269.         mov    ax, StdGrp
  270.         mov    ds, ax
  271.         push    fpacc.Exponent
  272.         push    fpacc.Mantissa       ;Save the stuff we tweak
  273.         push    fpacc.Mantissa[2]    ; so that this operation
  274.         push    fpacc.Mantissa[4]    ; will be non-destructive.
  275.         push    fpacc.Mantissa[6]
  276. ;
  277. ; First, round FPACC:
  278. ;
  279.         add    fpacc.Mantissa [4], 80h
  280.         adc    fpacc.Mantissa [6], 0
  281.         jnc    StoreAway
  282.         rcl    fpacc.Mantissa [6], 1
  283.         rcl    fpacc.Mantissa [4], 1
  284.         inc    fpacc.Exponent
  285.         jz    BadSSFPA        ;If exp overflows.
  286. ;
  287. ; Store the value away:
  288. ;
  289. StoreAway:    mov    ax, fpacc.Exponent
  290.         sub    ax, 32767-127        ;Convert to bias 127
  291.         cmp    ah, 0
  292.         jne    BadSSFPA
  293.         mov    bl, fpacc.Sign
  294.         shl    bl, 1            ;Merge in the sign bit.
  295.         rcr    al, 1
  296.         mov    es:[di] + 3, al        ;Save away exponent/sign
  297.         pushf                ;Save bit shifted out.
  298.         mov    ax, fpacc.Mantissa [6]
  299.         shl    ax, 1            ;Get rid of implied bit and
  300.         popf                ; shift in the L.O. exponent
  301.         rcr    ax, 1            ; bit.
  302.         mov    es:[di] + 1, ax
  303.         mov    al, byte ptr fpacc.Mantissa [5]
  304.         mov    es:[di], al
  305.         clc
  306.         jmp    SSFPADone
  307. ;
  308. BadSSFPA:    stc
  309. SSFPADone:    pop    fpacc.Mantissa[6]
  310.         pop    fpacc.Mantissa[4]
  311.         pop    fpacc.Mantissa[2]
  312.         pop    fpacc.Mantissa
  313.         pop    fpacc.Exponent
  314.         pop    bx
  315.         pop    ax
  316.         pop    ds
  317.         ret
  318.         assume    ds:nothing
  319. sl_SSFPA    endp
  320. ;
  321. ;
  322. ; sl_LDFPA-    Loads the double precision (64-bit) IEEE format number pointed
  323. ;        at by ES:DI into FPACC.
  324. ;
  325.         public    sl_LDFPA
  326. sl_LDFPA    proc    far
  327.         push    ax
  328.         push    bx
  329.         push    cx
  330.         mov    ax, es:6[di]
  331.         mov    StdGrp:fpacc.sign, ah    ;Save sign bit.
  332.         mov    cl, 4
  333.         shr    ax, cl            ;Align exponent field.
  334.         and    ah, 111b        ;Strip the sign bit.
  335.         add    ax, 32767-1023        ;Adjust bias
  336.         mov    StdGrp:fpacc.exponent, ax
  337. ;
  338. ; Get the mantissa bits and left justify them in the FPACC.
  339. ;
  340.         mov    ax, es:5[di]
  341.         and    ax, 0fffh        ;Strip exponent bits.
  342.         or    ah, 10h            ;Add in implied bit.
  343.         mov    cl, 3
  344.         shl    ax, cl
  345.         mov    bx, es:3[di]
  346.         rol    bx, cl
  347.         mov    ch, bl
  348.         and    ch, 7
  349.         or    al, ch
  350.         mov    StdGrp:fpacc.mantissa[6], ax
  351. ;
  352.         and    bl, 0f8h
  353.         mov    ax, es:1[di]
  354.         rol    ax, cl
  355.         mov    ch, al
  356.         and    ch, 7
  357.         or    bl, ch
  358.         mov    StdGrp:fpacc.mantissa[4], bx
  359. ;
  360.         and    al, 0f8h
  361.         mov    bh, es:[di]
  362.         rol    bh, cl
  363.         mov    ch, bh
  364.         and    ch, 7
  365.         or    al, ch
  366.         mov    StdGrp:fpacc.mantissa[2], ax
  367.         and    bh, 0f8h
  368.         mov    bl, 0
  369.         mov    StdGrp:fpacc.Mantissa[0], bx
  370. ;
  371.         pop    cx
  372.         pop    bx
  373.         pop    ax
  374.         ret
  375. sl_LDFPA    endp
  376. ;
  377. ;
  378. ;
  379. ;
  380. ; sl_SDFPA-    Stores FPACC into the double precision variable pointed
  381. ;        at by ES:DI.
  382. ;
  383.         public    sl_sdfpa
  384. sl_SDFPA    proc    far
  385.         assume    ds:stdgrp
  386.         push    ds
  387.         push    ax
  388.         push    bx
  389.         push    cx
  390.         push    dx
  391.         push    di
  392. ;
  393.         mov    bx, StdGrp
  394.         mov    ds, bx
  395. ;
  396.         push    fpacc.Mantissa [0]
  397.         push    fpacc.Mantissa [2]
  398.         push    fpacc.Mantissa [4]
  399.         push    fpacc.Mantissa [6]
  400.         push    fpacc.Exponent
  401. ;
  402. ; First, round this guy to 52 bits:
  403. ;
  404.         add    byte ptr fpacc.Mantissa [1], 8
  405.         jnc    SkipRndUp
  406.         inc    fpacc.Mantissa [2]
  407.         jnz    SkipRndUp
  408.         inc    fpacc.Mantissa [4]
  409.         jnz    SkipRndUp
  410.         inc    fpacc.Mantissa [6]
  411.         jnz    SkipRndUp
  412. ;
  413. ; Whoops!  Got an overflow, fix that here:
  414. ;
  415.         stc
  416.         rcr    fpacc.Mantissa [6], 1
  417.         rcr    fpacc.Mantissa [4], 1
  418.         rcr    fpacc.Mantissa [2], 1
  419.         rcr    byte ptr fpacc.Mantissa [1], 1
  420.         inc    fpacc.Exponent
  421.         jz    BadSDFPA        ;In case exp was really big.
  422. ;
  423. ; Okay, adjust and store the exponent-
  424. ;
  425. SkipRndUp:    mov    ax, fpacc.Exponent
  426.         sub    ax, 32767-1023        ;Adjust bias
  427.         cmp    ax, 2048        ;Make sure the value will still
  428.         jae    BadSDFPA        ; fit in an 8-byte real.
  429.         mov    cl, 5
  430.         shl    ax, cl            ;Move exponent into place.
  431.         mov    bl, fpacc.Sign
  432.         shl    bl, 1
  433.         rcr    ax, 1            ;Merge in sign bit.
  434. ;
  435. ; Merge in the upper four bits of the Mantissa (don't forget that the H.O.
  436. ; Mantissa bit is lost due to the implied one bit).
  437. ;
  438.         mov    bl, byte ptr fpacc.Mantissa [7]
  439.         shr    bl, 1
  440.         shr    bl, 1
  441.         shr    bl, 1
  442.         and    bl, 0fh            ;Strip away H.O. mant bit.
  443.         or    al, bl
  444.         mov    es:[di]+6, ax        ;Store away H.O. word.
  445. ;
  446. ; Okay, now adjust and store away the rest of the mantissa:
  447. ;
  448.         mov    ax, fpacc.Mantissa [0]
  449.         mov    bx, fpacc.Mantissa [2]
  450.         mov    cx, fpacc.Mantissa [4]
  451.         mov    dx, fpacc.Mantissa [6]
  452. ;
  453. ; Shift the bits to their appropriate places (to the left five bits):
  454. ;
  455.         shl    ax, 1
  456.         rcl    bx, 1
  457.         rcl    cx, 1
  458.         rcl    dx, 1
  459. ;
  460.         shl    ax, 1
  461.         rcl    bx, 1
  462.         rcl    cx, 1
  463.         rcl    dx, 1
  464. ;
  465.         shl    ax, 1
  466.         rcl    bx, 1
  467.         rcl    cx, 1
  468.         rcl    dx, 1
  469. ;
  470.         shl    ax, 1
  471.         rcl    bx, 1
  472.         rcl    cx, 1
  473.         rcl    dx, 1
  474. ;
  475.         shl    ax, 1
  476.         rcl    bx, 1
  477.         rcl    cx, 1
  478.         rcl    dx, 1
  479. ;
  480. ; Store away the results:
  481. ;
  482.         mov    es:[di], bx
  483.         mov    es:[di] + 2, cx
  484.         mov    es: [di] + 4, dx
  485. ;
  486. ; Okay, we're done.  Return carry clear to denote success.
  487. ;
  488.         clc
  489.         jmp    short QuitSDFPA
  490. ;
  491. BadSDFPA:    stc                ;If an error occurred.
  492. QuitSDFPA:    pop    fpacc.Exponent
  493.         pop    fpacc.Mantissa [6]
  494.         pop    fpacc.Mantissa [4]
  495.         pop    fpacc.Mantissa [2]
  496.         pop    fpacc.Mantissa [0]
  497.         pop    di
  498.         pop    dx
  499.         pop    cx
  500.         pop    bx
  501.         pop    ax
  502.         pop    ds
  503.         ret
  504. ;
  505.         assume    ds:nothing
  506. sl_SDFPA    endp
  507. ;
  508. ;
  509. ;
  510. ;
  511. ; sl_LEFPA-    Loads an extended precision (80-bit) IEEE format number
  512. ;        into the floating point accumulator.  ES:DI points at the
  513. ;        number to load into FPACC.
  514. ;
  515.         public    sl_LEFPA
  516. sl_LEFPA    proc    far
  517.         push    ax
  518.         mov    ax, es:8[di]
  519.         mov    StdGrp:fpacc.Sign, ah
  520.         and     ah, 7fh
  521.         add    ax, 4000h
  522.         mov    StdGrp:fpacc.Exponent, ax
  523.         mov    ax, es:[di]
  524.         mov    StdGrp:fpacc.Mantissa, ax
  525.         mov    ax, es:2[di]
  526.         mov    StdGrp:fpacc.Mantissa[2], ax
  527.         mov    ax, es:4[di]
  528.         mov    StdGrp:fpacc.Mantissa[4], ax
  529.         mov    ax, es:6[di]
  530.         mov    StdGrp:fpacc.Mantissa[6], ax
  531.         pop    ax
  532.         ret
  533. sl_LEFPA    endp
  534. ;
  535. ;
  536. ; sl_LEFPAL-    Loads an extended precision (80-bit) IEEE format number
  537. ;        into the floating point accumulator.  The number to load
  538. ;        into FPACC follows the call in the code stream.
  539. ;
  540.         public    sl_LEFPAL
  541. sl_LEFPAL    proc    far
  542.         push    bp
  543.         mov    bp, sp
  544.         push    es
  545.         push    di
  546.         push    ax
  547.         les    di, 2[bp]
  548. ;
  549.         mov    ax, es:8[di]
  550.         mov    StdGrp:fpacc.Sign, ah
  551.         and     ah, 7fh
  552.         add    ax, 4000h
  553.         mov    StdGrp:fpacc.Exponent, ax
  554.         mov    ax, es:[di]
  555.         mov    StdGrp:fpacc.Mantissa, ax
  556.         mov    ax, es:2[di]
  557.         mov    StdGrp:fpacc.Mantissa[2], ax
  558.         mov    ax, es:4[di]
  559.         mov    StdGrp:fpacc.Mantissa[4], ax
  560.         mov    ax, es:6[di]
  561.         mov    StdGrp:fpacc.Mantissa[6], ax
  562. ;
  563. ; Adjust the return address to point past the floating point number we
  564. ; just loaded.
  565. ;
  566.         add    word ptr 2[bp], 10
  567. ;
  568.         pop    ax
  569.         pop    di
  570.         pop    es
  571.         pop    bp
  572.         ret
  573. sl_LEFPAL    endp
  574. ;
  575. ;
  576. ; sl_SEFPA-    Stores FPACC into in the extended precision variable
  577. ;        pointed at by ES:DI.
  578. ;
  579.         public    sl_sefpa
  580. sl_SEFPA    proc    far
  581.         assume    ds:stdgrp
  582.         push    ds
  583.         push    ax
  584.         mov    ax, StdGrp
  585.         mov    ds, ax
  586.         push    fpacc.Mantissa [0]
  587.         push    fpacc.Mantissa [2]
  588.         push    fpacc.Mantissa [4]
  589.         push    fpacc.Mantissa [6]
  590.         push    fpacc.Exponent
  591. ;
  592.         mov    ax, fpacc.Exponent
  593.         sub    ax, 4000h
  594.         cmp    ax, 8000h
  595.         jae    BadSEFPA
  596.         test    fpacc.Sign, 80h
  597.         jz    StoreSEFPA
  598.         or    ah, 80h
  599. StoreSEFPA:    mov    es:[di]+8, ax
  600.         mov    ax, fpacc.Mantissa [0]
  601.         mov    es:[di], ax
  602.         mov    ax, fpacc.Mantissa [2]
  603.         mov    es:[di] + 2, ax
  604.         mov    ax, fpacc.Mantissa [4]
  605.         mov    es:[di] + 4, ax
  606.         mov    ax, fpacc.Mantissa [6]
  607.         mov    es:[di] + 6, ax
  608.         clc
  609.         jmp    SEFPADone
  610. ;
  611. BadSEFPA:    stc
  612. SEFPADone:    pop    fpacc.Exponent
  613.         pop    fpacc.Mantissa[6]
  614.         pop    fpacc.Mantissa[4]
  615.         pop    fpacc.Mantissa[2]
  616.         pop    fpacc.Mantissa[0]
  617.         pop    ax
  618.         pop    ds
  619.         ret
  620.         assume    ds:nothing
  621. sl_SEFPA        endp
  622. ;
  623. ;
  624. ;
  625. ; sl_LSFPO-     Loads a single precision (32-bit) IEEE format number into
  626. ;        the floating point operand.  ES:DI points at the # to
  627. ;        load into FPOP.
  628. ;
  629.         public    sl_LSFPO
  630. sl_LSFPO    proc    far
  631.         push    ax
  632.         push    bx
  633.         mov    ax, es:[di]
  634.         mov    word ptr StdGrp:fpop.mantissa[5], ax
  635.         mov    ax, es:2[di]
  636.         mov    bx, ax
  637.         shl    ax, 1
  638.         mov    al, ah
  639.         mov    ah, 0
  640.         add    ax, 32767-127        ;Adjust exponent bias.
  641.         mov    word ptr StdGrp:fpop.exponent, ax
  642.         mov    StdGrp:fpop.sign, bh    ;Save sign away.
  643.         mov    al, ds:2[di]
  644.         and    al, 7fh            ;Strip out L.O. exp bit.
  645.         or    al, 80h            ;Add in implied bit.
  646.         mov    byte ptr StdGrp:fpop.mantissa[7], al
  647.         xor    ax, ax
  648.         mov    word ptr StdGrp:fpop.mantissa, ax
  649.         mov    word ptr StdGrp:fpop.mantissa[2], ax
  650.         mov    byte ptr StdGrp:fpop.mantissa[4], al
  651.         pop    bx
  652.         pop    ax
  653.         ret
  654. sl_LSFPO    endp
  655. ;
  656. ;
  657. ;
  658. ;
  659. ;
  660. ; sl_LDFPO-    Loads the double precision (64-bit) IEEE format number pointed
  661. ;        at by ES:DI into FPOP.
  662. ;
  663.         public    sl_LDFPO
  664. sl_LDFPO    proc    far
  665.         push    ax
  666.         push    bx
  667.         push    cx
  668.         mov    ax, es:6[di]
  669.         mov    StdGrp:fpop.sign, ah    ;Save sign bit.
  670.         mov    cl, 4
  671.         shr    ax, cl            ;Align exponent field.
  672.         and    ah, 111b        ;Strip the sign bit.
  673.         add    ax, 32767-1023        ;Adjust bias
  674.         mov    word ptr StdGrp:fpop.exponent, ax
  675. ;
  676. ; Get the mantissa bits and left justify them in the FPOP.
  677. ;
  678.         mov    ax, es:5[di]
  679.         and    ax, 0fffh        ;Strip exponent bits.
  680.         or    ah, 10h            ;Add in implied bit.
  681.         mov    cl, 3
  682.         shl    ax, cl
  683.         mov    bx, es:3[di]
  684.         rol    bx, cl
  685.         mov    ch, bl
  686.         and    ch, 7
  687.         or    al, ch
  688.         mov    word ptr StdGrp:fpop.mantissa[6], ax
  689. ;
  690.         and    bl, 0f8h
  691.         mov    ax, es:1[di]
  692.         rol    ax, cl
  693.         mov    ch, al
  694.         and    ch, 7
  695.         or    bl, ch
  696.         mov    word ptr StdGrp:fpop.mantissa[4], bx
  697. ;
  698.         and    al, 0f8h
  699.         mov    bh, es:[di]
  700.         rol    bh, cl
  701.         mov    ch, bh
  702.         and    ch, 7
  703.         or    al, ch
  704.         mov    word ptr StdGrp:fpop.mantissa[2], ax
  705.         and    bh, 0f8h
  706.         mov    bl, 0
  707.         mov    word ptr StdGrp:fpop.Mantissa[0], bx
  708. ;
  709.         pop    cx
  710.         pop    bx
  711.         pop    ax
  712.         ret
  713. sl_LDFPO    endp
  714. ;
  715. ;
  716. ;
  717. ;
  718. ;
  719. ; sl_LEFPO-    Loads an extended precision (80-bit) IEEE format number
  720. ;        into the floating point operand.  ES:DI points at the
  721. ;        number to load into FPACC.
  722. ;
  723.         public    sl_LEFPO
  724. sl_LEFPO    proc    far
  725.         push    ax
  726.         mov    ax, es:8[di]
  727.         mov    StdGrp:fpop.Sign, ah
  728.         and     ah, 7fh
  729.         add    ax, 4000h
  730.         mov    StdGrp:fpop.Exponent, ax
  731.         mov    ax, es:[di]
  732.         mov    StdGrp:fpop.Mantissa, ax
  733.         mov    ax, es:2[di]
  734.         mov    StdGrp:fpop.Mantissa[2], ax
  735.         mov    ax, es:4[di]
  736.         mov    StdGrp:fpop.Mantissa[4], ax
  737.         mov    ax, es:6[di]
  738.         mov    StdGrp:fpop.Mantissa[6], ax
  739.         pop    ax
  740.         ret
  741. sl_LEFPO    endp
  742. ;
  743. ;
  744. ;
  745. ;
  746. ; sl_LEFPOL-    Loads an extended precision (80-bit) IEEE format number
  747. ;        into the floating point operand.  The number to load
  748. ;        follows the call instruction in the code stream.
  749. ;
  750.         public    sl_LEFPOL
  751. sl_LEFPOL    proc    far
  752.         push    bp
  753.         mov    bp, sp
  754.         push    es
  755.         push    di
  756.         push    ax
  757.         les    di, 2[bp]
  758. ;
  759.         mov    ax, es:8[di]
  760.         mov    StdGrp:fpop.Sign, ah
  761.         and     ah, 7fh
  762.         add    ax, 4000h
  763.         mov    StdGrp:fpop.Exponent, ax
  764.         mov    ax, es:[di]
  765.         mov    StdGrp:fpop.Mantissa, ax
  766.         mov    ax, es:2[di]
  767.         mov    StdGrp:fpop.Mantissa[2], ax
  768.         mov    ax, es:4[di]
  769.         mov    StdGrp:fpop.Mantissa[4], ax
  770.         mov    ax, es:6[di]
  771.         mov    StdGrp:fpop.Mantissa[6], ax
  772. ;
  773.         add    word ptr 2[bp], 10    ;Skip rtn adrs past #.
  774. ;
  775.         pop    ax
  776.         pop    di
  777.         pop    es
  778.         pop    bp
  779.         ret
  780. sl_LEFPOL    endp
  781. ;
  782. ;
  783. ;
  784. ;
  785. ;
  786. ;
  787. ;
  788. ;--------------------------------------------------------------------------
  789. ;         Integer <=> FP Conversions
  790. ;--------------------------------------------------------------------------
  791. ;
  792. ;
  793. ;
  794. ; ITOF-        Converts 16-bit signed value in AX to a floating point value
  795. ;        in FPACC.
  796. ;
  797.         public    sl_itof
  798. sl_itof        proc    far
  799.         assume    ds:stdgrp
  800.         push    ds
  801.         push    ax
  802.         push    cx
  803.         mov    cx, StdGrp
  804.         mov    ds, cx
  805. ;
  806.         mov    cx, 800Fh        ;Magic exponent value (65536).
  807. ;
  808. ; Set the sign of the result:
  809. ;
  810.         mov    fpacc.Sign, 0        ;Assume a positive value.
  811.         or    ax, ax            ;Special case for zero!
  812.         jz    SetFPACC0
  813.         jns    DoUTOF            ;Take care of neg values.
  814.         mov    fpacc.sign, 80h        ;This guy is negative!
  815.         neg    ax            ;Work with abs(AX).
  816.         jmp    DoUTOF
  817. sl_ITOF        endp
  818. ;
  819. ;
  820. ; UTOF-        Like ITOF above except this guy works for unsigned 16-bit
  821. ;        integer values.
  822. ;
  823.         public    sl_utof
  824. sl_UTOF        proc    far
  825.         push    ds
  826.         push    ax
  827.         push    cx
  828. ;
  829. ;
  830.         mov    cx, StdGrp
  831.         mov    ds, cx
  832.         mov    cx, 800Fh        ;Magic exponent value (65536).
  833.         or    ax, ax
  834.         jz    SetFPACC0
  835.         mov    fpacc.Sign, 0
  836. ;
  837. sl_UTOF        endp
  838. ;
  839. ;
  840. ; Okay, convert the number to a floating point value:
  841. ; Remember, we need to end up with a normalized number (one where the H.O.
  842. ; bit of the mantissa contains a one).  The largest possible value (65535 or
  843. ; 0FFFFh) is equal to 800E FFFF 0000 0000 0000.  All other values have an
  844. ; exponent less than or equal to 800Eh.  If the H.O. bit of the value is
  845. ; not one, we must shift it to the left and dec the exp by 1.  E.g., if AX
  846. ; contains 1, then we will need to shift it 15 times to normalize the value,
  847. ; decrementing the exponent each time produces 7fffh which is the proper
  848. ; exponent for "1".
  849. ;
  850. ; Note: this is not a proc!  Making it a proc makes it incompatible with
  851. ; one or more different assemblers (TASM, OPTASM, MASM6).
  852. ; Besides, this has to be a near label with a far return!
  853. ;
  854. DoUTOF:
  855. UTOFWhlPos:    dec    cx
  856.         shl    ax, 1
  857.         jnc    UTOFWhlPos
  858.         rcr    ax, 1            ;Put bit back.
  859.         mov    fpacc.Exponent, cx    ;Save exponent value.
  860.         mov    fpacc.Mantissa [6], ax    ;Save Mantissa value.
  861.         xor    ax, ax
  862.         mov    fpacc.Mantissa [4], ax    ;Zero out the rest of the
  863.         mov    fpacc.Mantissa [2], ax    ; mantissa.
  864.         mov    fpacc.Mantissa [0], ax
  865.         jmp     UTOFDone
  866. ;
  867. ; Special case for zero, must zero all bytes in FPACC.  Note that AX already
  868. ; contains zero.
  869. ;
  870. SetFPACC0:    mov    fpacc.Exponent, ax
  871.         mov    fpacc.Mantissa [6], ax
  872.         mov    fpacc.Mantissa [4], ax
  873.         mov    fpacc.Mantissa [2], ax
  874.         mov    fpacc.Mantissa [0], ax
  875.         mov    fpacc.Sign, al
  876. ;
  877. UTOFDone:    pop    cx
  878.         pop    ax
  879.         pop    ds
  880.         retf
  881. ;
  882. ;
  883. ;
  884. ;
  885. ;
  886. ;
  887. ; LTOF-        Converts 32-bit signed value in DX:AX to a floating point
  888. ;        value in FPACC.
  889. ;
  890.         public    sl_ltof
  891. sl_ltof        proc    far
  892.         assume    ds:stdgrp
  893.         push    ds
  894.         push    ax
  895.         push    cx
  896.         push    dx
  897.         mov    cx, StdGrp
  898.         mov    ds, cx
  899. ;
  900. ; Set the sign of the result:
  901. ;
  902.         mov    fpacc.Sign, 0        ;Assumed a positive value.
  903.         mov    cx, dx
  904.         or    cx, ax
  905.         jz    SetUL0
  906.         or    dx, dx            ;Special case for zero!
  907.         jns    DoULTOF            ;Take care of neg values.
  908.         mov    fpacc.sign, 80h        ;This guy is negative!
  909.         neg    dx            ;Do a 32-bit NEG operation
  910.         neg    ax            ; (yes, this really does
  911.         sbb    dx, 0            ;  work!).
  912.         jmp    DoULTOF
  913. sl_LTOF        endp
  914. ;
  915. ;
  916. ; ULTOF-    Like LTOF above except this guy works for unsigned 32-bit
  917. ;        integer values.
  918. ;
  919.         public    sl_ultof
  920. sl_ULTOF    proc    far
  921.         push    ds
  922.         push    ax
  923.         push    cx
  924.         push    dx
  925. ;
  926.         mov    cx, StdGrp
  927.         mov    ds, cx
  928. ;
  929.         mov    cx, dx
  930.         or    cx, ax
  931.         jz    SetUL0
  932.         mov    fpacc.Sign, 0
  933. ;
  934. sl_ULTOF        endp
  935. ;
  936. ;
  937. ;
  938. DoULTOF:
  939.         mov    cx, 801Fh        ;Magic exponent value (65536).
  940. ULTOFWhlPos:    dec    cx
  941.         shl    ax, 1
  942.         rcl    dx, 1
  943.         jnc    ULTOFWhlPos
  944.         rcr    dx, 1            ;Put bit back.
  945.         rcr    ax, 1
  946.         mov    fpacc.Exponent, cx    ;Save exponent value.
  947.         mov    fpacc.Mantissa [6], dx    ;Save Mantissa value.
  948.         mov    fpacc.Mantissa [4], ax
  949.         xor    ax, ax            ;Zero out the rest of the
  950.         mov    fpacc.Mantissa [2], ax    ; mantissa.
  951.         mov    fpacc.Mantissa [0], ax
  952.         jmp     ULTOFDone
  953. ;
  954. ; Special case for zero, must zero all bytes in FPACC.  Note that AX already
  955. ; contains zero.
  956. ;
  957. SetUL0:        mov    fpacc.Exponent, ax
  958.         mov    fpacc.Mantissa [6], ax
  959.         mov    fpacc.Mantissa [4], ax
  960.         mov    fpacc.Mantissa [2], ax
  961.         mov    fpacc.Mantissa [0], ax
  962.         mov    fpacc.Sign, al
  963. ;
  964. ULTOFDone:    pop    dx
  965.         pop    cx
  966.         pop    ax
  967.         pop    ds
  968.         retf
  969. ;
  970. ;
  971. ;
  972. ;
  973. ; FTOI- Converts the floating point value in FPACC to a signed 16-bit
  974. ;    integer and returns this integer in AX.
  975. ;    Returns carry set if the number is too big to fit into AX.
  976. ;
  977.         public    sl_FTOI
  978. sl_FTOI        proc    far
  979.         assume    ds:stdgrp
  980.         push    ds
  981.         push    cx
  982.         mov    cx, StdGrp
  983.         mov    ds, cx
  984. ;
  985.         mov    cx, fpacc.Exponent
  986.         cmp    cx, 800eh
  987.         jb    FTOIok
  988. ;
  989. ; Handle special case of -32768:
  990. ;
  991.         call    DoFToU
  992.         cmp    ax, 8000h
  993.         je    FtoiOk2
  994.         stc
  995.         jmp    TooBig
  996. ;
  997. FTOIok:        call    DoFTOU
  998. FtoiOk2:    cmp    fpacc.Sign, 0
  999.         jns    FTOIJustRight
  1000.         neg    ax
  1001. FTOIJustRight:    clc
  1002. TooBig:        pop    cx
  1003.         pop    ds
  1004.         ret
  1005. sl_FTOI        endp
  1006. ;
  1007. ;
  1008. ;
  1009. ;
  1010. ; FTOU- Like FTOI above, except this guy converts a floating point value
  1011. ;     to an unsigned integer in AX.
  1012. ;    Returns carry set if out of range (including negative numbers).
  1013. ;
  1014.         public    sl_FTOU
  1015. sl_FTOU        proc    far
  1016.         assume    ds:stdgrp
  1017.         push    ds
  1018.         push    cx
  1019.         mov    cx, StdGrp
  1020.         mov    ds, cx
  1021. ;
  1022.         mov    cx, fpacc.Exponent
  1023.         cmp    cx, 800fh
  1024.         jb    FTOUok
  1025. BadU:        stc
  1026.         jmp    UTooBig
  1027. ;
  1028. FTOUok:        call    DoFTOU
  1029.         cmp    fpacc.Sign, 0
  1030.         js    BadU
  1031. ;
  1032. FTOUJustRight:    clc
  1033. UTooBig:    pop    cx
  1034.         pop    ds
  1035.         ret
  1036. sl_FTOU        endp
  1037. ;
  1038. ;
  1039. ; DoFTOU- This code does the actual conversion!
  1040. ;
  1041. DoFTOU        proc    near
  1042.         mov    ax, fpacc.Mantissa [6]
  1043.         cmp    cx, 7fffh
  1044.         jb    SetFTOU0
  1045.         sub    cx, 800eh
  1046.         neg    cx
  1047.         shr    ax, cl
  1048.         ret
  1049. ;
  1050. SetFTOU0:    xor    ax, ax
  1051.         ret
  1052. DoFTOU        endp
  1053. ;
  1054. ;
  1055. ;
  1056. ;
  1057. ;
  1058. ; FTOL- Converts the floating point value in FPACC to a signed 32-bit
  1059. ;    integer and returns this integer in DX:AX.
  1060. ;    Returns carry set if the number is too big to fit into DX:AX.
  1061. ;
  1062.         public    sl_FTOL
  1063. sl_FTOL        proc    far
  1064.         assume    ds:StdGrp
  1065.         push    ds
  1066.         push    cx
  1067.         mov    cx, StdGrp
  1068.         mov    ds, cx
  1069. ;
  1070.         mov    cx, fpacc.Exponent
  1071.         cmp    cx, 801eh
  1072.         jb    FTOLok
  1073.         stc
  1074.         jmp    LTooBig
  1075. ;
  1076. FTOLok:        call    DoFTOUL
  1077.         cmp    fpacc.Sign, 0
  1078.         jns    FTOLJustRight
  1079.         neg    dx            ;32-bit negate operation.
  1080.         neg    ax
  1081.         sbb    dx, 0
  1082. FTOLJustRight:    clc
  1083. LTooBig:    pop    cx
  1084.         pop    ds
  1085.         ret
  1086. sl_FTOL        endp
  1087. ;
  1088. ;
  1089. ;
  1090. ;
  1091. ; FTOUL-Like FTOL above, except this guy converts a floating point value
  1092. ;     to a 32-bit unsigned integer in DX:AX.
  1093. ;    Returns carry set if out of range (including negative numbers).
  1094. ;
  1095.         public    sl_FTOUL
  1096. sl_FTOUL    proc    far
  1097.         assume    ds:StdGrp
  1098.         push    ds
  1099.         push    cx
  1100.         mov    cx, StdGrp
  1101.         mov    ds, cx
  1102. ;
  1103.         mov    cx, fpacc.Exponent
  1104.         cmp    cx, 801fh
  1105.         jb    FTOULok
  1106. BadUL:        stc
  1107.         jmp    ULTooBig
  1108. ;
  1109. FTOULok:    call    DoFTOUL
  1110.         cmp    fpacc.Sign, 0
  1111.         js    BadUL
  1112. ;
  1113.         clc                ;If the # is okay.
  1114. ULTooBig:    pop    cx
  1115.         pop    ds
  1116.         ret
  1117. sl_FTOUL    endp
  1118. ;
  1119. ;
  1120. ; DoFTOUL- This code does the actual conversion!
  1121. ;
  1122. DoFTOUL        proc    near
  1123.         mov    dx, fpacc.Mantissa [6]
  1124.         mov    ax, fpacc.Mantissa [4]
  1125.         cmp    cx, 7fffh
  1126.         jb    SetFTOUL0
  1127.         sub    cx, 801eh
  1128.         neg    cx
  1129.         jcxz    SetFTOULDone
  1130. FTOULLp:    shr    dx, 1
  1131.         rcr    ax, 1
  1132.         loop    FTOULLp
  1133. SetFToULDone:    ret
  1134. ;
  1135. SetFTOUL0:    xor    ax, ax
  1136.         xor    dx, dx
  1137.         ret
  1138. DoFTOUL        endp
  1139. ;
  1140. ;
  1141. ;
  1142. ;
  1143. ;
  1144. ;
  1145. ;
  1146. ;
  1147. ;
  1148. ;
  1149. ;
  1150. ;
  1151. ;
  1152. ;---------------------------------------------------------------------------
  1153. ;        Floating Point Addition & Subtraction
  1154. ;---------------------------------------------------------------------------
  1155. ;
  1156. ;
  1157. ;
  1158. ;
  1159. ; FADD- Adds FOP to FACC
  1160. ; FSUB- Subtracts FOP from FACC
  1161. ;    These routines destroy the value in FPOP!
  1162. ;
  1163.         public    sl_fsub
  1164.         public    sl_fadd
  1165. ;
  1166.         assume    ds:nothing
  1167. sl_fsub        proc    far
  1168.         xor    StdGrp:fpop.sign, 80h
  1169. sl_fsub        endp
  1170. ;
  1171.         assume    ds:StdGrp
  1172. sl_fadd        proc    far
  1173.         push    ds
  1174.         push    ax
  1175.         push    bx
  1176.         push    cx
  1177.         push    dx
  1178.         push    si
  1179.  
  1180. ; Use the current CS as the data segment to get direct access to
  1181. ; the floating point accumulator and operands.
  1182.  
  1183.         mov    ax, StdGrp
  1184.         mov    ds, ax
  1185.  
  1186. ; Kludge Alert!  Check to see if either operand is zero.  This code doesn't
  1187. ; deal with zero very gracefully, so we have to specially check for zero
  1188. ; here.
  1189.  
  1190.         mov    ax, fpacc.Mantissa[0]
  1191.         or    ax, fpacc.Mantissa[2]
  1192.         or    ax, fpacc.Mantissa[4]
  1193.         or    ax, fpacc.Mantissa[6]
  1194.         jne    FPACCNot0        ; the whole thing is zero.
  1195.  
  1196.         mov    ax, fpop.exponent    ;If FPACC is zero, simply
  1197.         mov    fpacc.exponent, ax    ; copy FPOP to FPACC.
  1198.         mov    ax, fpop.Mantissa[0]
  1199.         mov    fpacc.Mantissa[0], ax
  1200.         mov    ax, fpop.Mantissa[2]
  1201.         mov    fpacc.Mantissa[2], ax
  1202.         mov    ax, fpop.Mantissa[4]
  1203.         mov    fpacc.Mantissa[4], ax
  1204.         mov    ax, fpop.Mantissa[6]
  1205.         mov    fpacc.Mantissa[6], ax
  1206.         mov    al, fpop.Sign
  1207.         mov    fpacc.Sign, al
  1208.         jmp    Done
  1209.  
  1210. FPACCNot0:
  1211.         mov    ax, fpop.Mantissa[0]
  1212.         or    ax, fpop.Mantissa[2]
  1213.         or    ax, fpop.Mantissa[4]
  1214.         or    ax, fpop.Mantissa[6]
  1215.         jne    FPOPNot0
  1216.         jmp    Done
  1217.  
  1218. ; Adjust the smaller of the two operands so that the exponents of the two
  1219. ; objects are the same:
  1220.  
  1221. FPOPNot0:
  1222.         mov    cx, fpacc.exponent
  1223.         sub    cx, fpop.exponent
  1224.         js    gotoAdjustFPA
  1225.         jnz    AdjustFPOP
  1226.         jmp    Adjusted        ;Only if exponents are equal.
  1227. gotoAdjustFPA:    jmp    AdjustFPACC
  1228. ;
  1229. ; Since the difference of the exponents is negative, the magnitude of FPOP
  1230. ; is smaller than the magnitude of fpacc.  Adjust FPOP here.
  1231. ;
  1232. AdjustFPOP:    cmp    cx, 64            ;If greater than 64, forget
  1233.         jb    short By16LoopTest    ; it.  Sum is equal to FPACC.
  1234.         jmp    Done
  1235. ;
  1236. ; If the difference is greater than 16 bits, adjust FPOP a word at a time.
  1237. ; Note that there may be multiple words adjusted in this fashion.
  1238. ;
  1239. By16Loop:    mov    ax, fpop.mantissa[2]
  1240.         mov    fpop.mantissa[0], ax
  1241.         mov    ax, fpop.mantissa[4]
  1242.         mov    fpop.mantissa[2], ax
  1243.         mov    ax, fpop.mantissa[6]
  1244.         mov    fpop.mantissa[4], ax
  1245.         mov    fpop.mantissa[6], 0
  1246.         sub    cx, 16
  1247. By16LoopTest:    cmp    cx, 16
  1248.         jae    By16Loop
  1249. ;
  1250. ; After adjusting sixteen bits at a time, see if there are at least eight
  1251. ; bits.  Note that this can only occur once, for if you could adjust by
  1252. ; eight bits twice, you could have adjusted by 16 above.
  1253. ;
  1254.         cmp    cx, 8
  1255.         jb    NotBy8
  1256.         mov    ax, fpop.mantissa[1]
  1257.         mov    fpop.mantissa[0], ax
  1258.         mov    ax, fpop.mantissa[3]
  1259.         mov    fpop.mantissa[2], ax
  1260.         mov    ax, fpop.mantissa[5]
  1261.         mov    fpop.mantissa[4], ax
  1262.         mov    al, byte ptr fpop.mantissa [7]
  1263.         mov    byte ptr fpop.mantissa [6], al
  1264.         mov    byte ptr fpop.mantissa[7], 0
  1265.         sub    cx, 8
  1266. ;
  1267. ; Well, now we're down to a bit at a time.
  1268. ;
  1269. NotBy8:        jcxz    AdjFPOPDone
  1270. ;
  1271. ; Load the mantissa into registers to save processing time.
  1272. ;
  1273.         mov    ax, fpop.mantissa[6]
  1274.         mov    bx, fpop.mantissa[4]
  1275.         mov    dx, fpop.mantissa[2]
  1276.         mov    si, fpop.mantissa[0]
  1277. By1Loop:    shr    ax, 1
  1278.         rcr    bx, 1
  1279.         rcr    dx, 1
  1280.         rcr    si, 1
  1281.         loop    By1Loop
  1282.         mov    fpop.mantissa[6], ax    ;Save result back into
  1283.         mov    fpop.mantissa[4], bx    ; fpop.
  1284.         mov    fpop.mantissa[2], dx
  1285.         mov    fpop.mantissa[0], si
  1286. AdjFPOPDone:    jmp     Adjusted
  1287. ;
  1288. ;
  1289. ;
  1290. ; AdjustFPACC- FPACC was smaller than FPOP, so adjust its bits down here.
  1291. ;           This code is pretty much identical to the above, the same
  1292. ;           comments apply.
  1293. ;
  1294. AdjustFPACC:    neg    cx            ;Take ABS(cx)
  1295.         cmp    cx, 64            ;If greater than 64, forget
  1296.         jb    By16LpTest        ; it.
  1297.         jmp    SetFPACC2Zero
  1298. ;
  1299. By16Lp:        mov    ax, fpacc.mantissa[2]
  1300.         mov    fpacc.mantissa[0], ax
  1301.         mov    ax, fpacc.mantissa[4]
  1302.         mov    fpacc.mantissa[2], ax
  1303.         mov    ax, fpacc.mantissa[6]
  1304.         mov    fpacc.mantissa[4], ax
  1305.         mov    fpacc.mantissa[6], 0
  1306.         sub    cx, 16
  1307. By16LpTest:    cmp    cx, 16
  1308.         jae    By16Lp
  1309. ;
  1310.         cmp    cx, 8
  1311.         jb    NotBy8a
  1312.         mov    ax, fpacc.mantissa[1]
  1313.         mov    fpacc.mantissa[0], ax
  1314.         mov    ax, fpacc.mantissa[3]
  1315.         mov    fpacc.mantissa[2], ax
  1316.         mov    ax, fpacc.mantissa[5]
  1317.         mov    fpacc.mantissa[4], ax
  1318.         mov    al, byte ptr fpacc.mantissa [7]
  1319.         mov    byte ptr fpacc.mantissa [6], al
  1320.         mov    byte ptr fpacc.mantissa[7], 0
  1321.         sub    cx, 8
  1322. ;
  1323. NotBy8a:    jcxz    Adjusted
  1324.         mov    ax, fpacc.mantissa[6]
  1325.         mov    bx, fpacc.mantissa[4]
  1326.         mov    dx, fpacc.mantissa[2]
  1327.         mov    si, fpacc.mantissa[0]
  1328. By1Lp:        shr    ax, 1
  1329.         rcr    bx, 1
  1330.         rcr    dx, 1
  1331.         rcr    si, 1
  1332.         loop    By1Lp
  1333.         mov    fpacc.mantissa[6], ax
  1334.         mov    fpacc.mantissa[4], bx
  1335.         mov    fpacc.mantissa[2], dx
  1336.         mov    fpacc.mantissa[0], si
  1337.         mov    ax, fpop.Exponent    ;FPACC assumes the same
  1338.         mov    fpacc.Exponent, ax    ; exponent as FPOP.
  1339. AdjFPACCDone:    jmp     Adjusted
  1340. ;
  1341. ; If FPACC is so much smaller than FPOP that it is insignificant, set
  1342. ; it to zero.
  1343. ;
  1344. SetFPACC2Zero:    xor    ax, ax
  1345.         mov    fpacc.mantissa[0], ax
  1346.         mov    fpacc.mantissa[2], ax
  1347.         mov    fpacc.mantissa[4], ax
  1348.         mov    fpacc.mantissa[6], ax
  1349.         mov    fpacc.exponent, ax
  1350.         mov    fpacc.sign, al
  1351. ;
  1352. ; Now that the mantissas are aligned, let's add (or subtract) them.
  1353. ;
  1354. Adjusted:    mov    al, fpacc.sign
  1355.         xor    al, fpop.sign
  1356.         js    SubEm
  1357. ;
  1358. ; If the signs are the same, simply add the mantissas together here.
  1359. ;
  1360.         mov    ax, fpop.mantissa[0]
  1361.         add    fpacc.mantissa[0], ax
  1362.         mov    ax, fpop.mantissa[2]
  1363.         adc    fpacc.mantissa[2], ax
  1364.         mov    ax, fpop.mantissa[4]
  1365.         adc    fpacc.mantissa[4], ax
  1366.         mov    ax, fpop.mantissa[6]
  1367.         adc    fpacc.mantissa[6], ax
  1368.         jnc    Normalize
  1369. ;
  1370. ; If there was a carry out of the addition (quite possible since most
  1371. ; fp values are normalized) then we need to shove the bit back into
  1372. ; the number.
  1373. ;
  1374.         rcr    fpacc.mantissa[6], 1
  1375.         rcr    fpacc.mantissa[4], 1
  1376.         rcr    fpacc.mantissa[2], 1
  1377.         rcr    fpacc.mantissa[0], 1
  1378.         inc    fpacc.exponent
  1379. ;
  1380. ; If there was a carry out of the bottom, add it back in (this rounds the
  1381. ; result).  No need to worry about a carry out of the H.O. bit this time--
  1382. ; there is no way to add together two numbers to get a carry *and* all
  1383. ; one bits in the result.  Therefore, rounding at this point will not
  1384. ; propagate all the way through.
  1385. ;
  1386.         adc    fpacc.Mantissa [0], 0
  1387.         jnc    Normalize
  1388.         inc    fpacc.Mantissa [2]
  1389.         jnz    Normalize
  1390.         inc    fpacc.Mantissa [4]
  1391.         jnz    Normalize
  1392.         inc    fpacc.Mantissa [6]
  1393.         jmp    Normalize
  1394. ;
  1395. ;
  1396. ;
  1397. ; If the signs are different, we've got to deal with four possibilities:
  1398. ;
  1399. ; 1) fpacc is negative and its magnitude is greater than fpop's.
  1400. ;    Result is negative, fpacc.mant := fpacc.mant - fpop.mant.
  1401. ;
  1402. ; 2) fpacc is positive and its magnitude is greater than fpop's.
  1403. ;    Result is positive, fpacc.mant := fpacc.mant - fpop.mant.
  1404. ;
  1405. ; 3) fpacc is negative and its magnitude is less than fpop's.
  1406. ;    Result is positive, fpacc.mant := fpop.mant - fpacc.mant.
  1407. ;
  1408. ; 4) fpacc is positive and its magnitude is less than fpop's.
  1409. ;    Result is negative, fpacc.mant := fpop.mant - fpacc.mant.
  1410. ;
  1411. SubEm:        mov    ax, fpacc.mantissa[0]
  1412.         mov    bx, fpacc.mantissa[2]
  1413.         mov    dx, fpacc.mantissa[4]
  1414.         mov    si, fpacc.mantissa[6]
  1415.         sub    ax, fpop.mantissa[0]
  1416.         sbb    bx, fpop.mantissa[2]
  1417.         sbb    dx, fpop.mantissa[4]
  1418.         sbb     si, fpop.mantissa[6]
  1419.         jnc    StoreFPACC
  1420. ;
  1421. ; Whoops!  FPOP > FPACC, fix that down here.
  1422. ;
  1423.         not    ax
  1424.         not    bx
  1425.         not    dx
  1426.         not    si
  1427.         inc     ax
  1428.         jnz    StoreFPACCSign
  1429.         inc    bx
  1430.         jnz    StoreFPAccSign
  1431.         inc    dx
  1432.         jnz    StoreFPAccSign
  1433.         inc    si
  1434. ;
  1435. StoreFPAccSign:    xor    fpacc.sign, 80h            ;Flip sign if case 3/4.
  1436. ;
  1437. StoreFPAcc:    mov    fpacc.mantissa[0], ax
  1438.         mov    fpacc.mantissa[2], bx
  1439.         mov    fpacc.mantissa[4], dx
  1440.         mov    fpacc.mantissa[6], si
  1441.  
  1442.  
  1443. ; Normalize the result down here.  Start by shifting 16 bits at a time,
  1444. ; then eight bits, then one bit at a time.
  1445.  
  1446. Normalize:    mov    ax, fpacc.Mantissa[0]    ;First, see if the result
  1447.         or    ax, fpacc.Mantissa[2]    ; is zero.  Can't normalize
  1448.         or    ax, fpacc.Mantissa[4]    ; if this is the case.
  1449.         or    ax, fpacc.Mantissa[6]
  1450.         jnz    NormLoop
  1451.         mov    fpacc.Exponent, ax    ;Force everything to zero
  1452.         mov    fpacc.Sign, al        ; if result is zero.
  1453.         jmp    Done
  1454.  
  1455. NormLoop:    mov    ax, fpacc.mantissa[6]
  1456.         or    ax, ax                  ;See if zero (which means we
  1457.         jnz    Try8Bits        ; can shift 16 bits).
  1458.         mov    ax, fpacc.mantissa[4]
  1459.         mov    fpacc.mantissa[6], ax
  1460.         mov    ax, fpacc.mantissa[2]
  1461.         mov    fpacc.mantissa[4], ax
  1462.         mov    ax, fpacc.mantissa[0]
  1463.         mov    fpacc.mantissa[2], ax
  1464.         mov    fpacc.mantissa[0],0
  1465.         sub    fpacc.exponent, 16
  1466.         jmp    NormLoop
  1467. ;
  1468. ; Okay, see if we can normalize eight bits at a shot.
  1469. ;
  1470. Try8Bits:    mov    al, byte ptr fpacc.mantissa[7]
  1471.         cmp    al, 0
  1472.         jnz    Try1Bit
  1473.         mov    ax, fpacc.mantissa[5]
  1474.         mov    fpacc.mantissa[6], ax
  1475.         mov    ax, fpacc.mantissa[3]
  1476.         mov    fpacc.mantissa[4], ax
  1477.         mov    ax, fpacc.mantissa[1]
  1478.         mov    fpacc.mantissa[3], ax
  1479.         mov    al, byte ptr fpacc.mantissa[0]
  1480.         mov    byte ptr fpacc.mantissa[1], al
  1481.         mov    byte ptr fpacc.mantissa[0], 0
  1482.         sub    fpacc.exponent, 8
  1483. ;
  1484. Try1Bit:    mov    ax, fpacc.mantissa[6]
  1485.         test    ah, 80h
  1486.         jnz    Done
  1487.         mov    bx, fpacc.mantissa[4]
  1488.         mov    dx, fpacc.mantissa[2]
  1489.         mov    si, fpacc.mantissa[0]
  1490. OneBitLp:    dec    fpacc.exponent
  1491.         shl    si, 1
  1492.         rcl    dx, 1
  1493.         rcl    bx, 1
  1494.         rcl    ax, 1
  1495.         or    ax, ax            ;See if bit 15 is set.
  1496.         jns    OneBitLp
  1497.         mov    fpacc.mantissa[6], ax
  1498.         mov    fpacc.mantissa[4], bx
  1499.         mov    fpacc.mantissa[2], dx
  1500.         mov    fpacc.mantissa[0], si
  1501. ;
  1502. Done:
  1503.         pop    si
  1504.         pop    dx
  1505.         pop    cx
  1506.         pop    bx
  1507.         pop    ax
  1508.         pop    ds
  1509.         ret
  1510. sl_fadd        endp
  1511. ;
  1512. ;
  1513. ;
  1514. ;
  1515. ;
  1516. ;
  1517. ;
  1518. ;
  1519. ;
  1520. ;
  1521. ;---------------------------------------------------------------------------
  1522. ; Floating point comparison.
  1523. ;---------------------------------------------------------------------------
  1524. ;
  1525. ;
  1526. ; FCMP
  1527. ; Compares value in FPACC to value in FPOP.
  1528. ; Returns -1 in AX if FPACC is less than FPOP,
  1529. ; Returns 0  in AX if FPACC is equal to FPOP,
  1530. ; Returns 1  in AX if FPACC is greater than FPOP.
  1531. ;
  1532. ; Also returns this status in the flags (by comparing AX against zero
  1533. ; before returning) so you can use JE, JNE, JG, JGE, JL, or JLE after this
  1534. ; routine to test the comparison.
  1535. ;
  1536.         public    sl_fcmp
  1537. sl_fcmp        proc    far
  1538.         assume    ds:StdGrp
  1539.         push    ds
  1540.         mov    ax, StdGrp
  1541.         mov    ds, ax
  1542. ;
  1543. ; First compare the signs of the mantissas.  If they are different, the
  1544. ; negative one is smaller.
  1545. ;
  1546.         mov    al, byte ptr FPACC+10    ;Get sign bit
  1547.         xor    al, byte ptr FPOP+10    ;See if the signs are different
  1548.         jns    SameSign
  1549. ;
  1550. ; If the signs are different, then the sign of FPACC determines the result
  1551. ;
  1552.         test    byte ptr FPACC+10, 80h
  1553.         jnz    IsLT
  1554.         jmp    short IsGT
  1555. ;
  1556. ; Down here the signs are the same.  First order of business is to compare
  1557. ; the exponents.  The one with the larger exponent wins.  If the exponents
  1558. ; are equal, then we need to compare the mantissas.  If the mantissas are
  1559. ; the same then the two numbers are equal.  If the mantissas are different
  1560. ; then the larger one wins.  Note that this discussion is for positive values
  1561. ; only, if the numbers are negative, then we must reverse the win/loss value
  1562. ; (win=GT).
  1563. ;
  1564. SameSign:    mov    ax, FPACC.exponent    ;One thing cool about bias-
  1565.         cmp    ax, FPOP.exponent    ; 1023 exponents is that we
  1566.         ja    MayBeGT            ; can use an unsigned compare
  1567.         jb    MayBeLT
  1568. ;
  1569. ; If the exponents are equal, we need to start comparing the mantissas.
  1570. ; This straight line code turns out to be about the fastest way to do it.
  1571. ;
  1572.         mov    ax, word ptr FPACC.mantissa+6
  1573.         cmp    ax, word ptr FPOP.mantissa+6
  1574.         ja    MayBeGT
  1575.         jb    MayBeLT
  1576.         mov    ax, word ptr FPACC.mantissa+4
  1577.         cmp    ax, word ptr FPOP.mantissa+4
  1578.         ja    MayBeGT
  1579.         jb    MayBeLT
  1580.         mov    ax, word ptr FPACC.mantissa+2
  1581.         cmp    ax, word ptr FPOP.mantissa+2
  1582.         ja    MayBeGT
  1583.         jb    MayBeLT
  1584.         mov    ax, word ptr FPACC.mantissa
  1585.         cmp    ax, word ptr FPOP.mantissa
  1586.         ja    MayBeGT
  1587.         je    IsEq            ;They're equal at this point.
  1588. ;
  1589. ; MayBeLT- Looks like less than so far, but we need to check the sign of the
  1590. ; numbers, if they are negative then FPACC is really GT FPOP.  Remember, the
  1591. ; sign is not part of the mantissa!
  1592. ;
  1593. MayBeLT:    test    FPACC.sign, 80h
  1594.         js    IsGT
  1595. ;
  1596. IsLT:        mov    ax, -1
  1597.         jmp    short cmpRtn
  1598. ;
  1599. ; Same story here for MayBeGT
  1600. ;
  1601. MayBeGT:    test    FPACC.sign, 80h
  1602.         js    IsLT
  1603. ;
  1604. IsGT:        mov    ax, 1
  1605.         jmp    short cmpRtn
  1606. ;
  1607. IsEq:        xor    ax, ax
  1608. cmpRtn:        pop    ds
  1609.         cmp    ax, 0            ;Set the flags as appropriate
  1610.         ret
  1611. sl_fcmp        endp
  1612.         assume    ds:nothing
  1613. ;
  1614. ;
  1615. ;
  1616. ;
  1617. ;
  1618. ;
  1619. ;
  1620. ;
  1621. ;
  1622. ;
  1623. ;
  1624. ;
  1625. ;
  1626. ;---------------------------------------------------------------------------
  1627. ;        Floating Point Multiplication
  1628. ;---------------------------------------------------------------------------
  1629. ;
  1630. ;
  1631. ;
  1632. ;
  1633. ; sl_fmul- Multiplies facc by fop and leaves the result in facc.
  1634. ;
  1635.         public    sl_fmul
  1636. sl_fmul        proc    far
  1637.         assume    ds:StdGrp
  1638.         push    ds
  1639.         push    ax
  1640.         push    bx
  1641.         push    cx
  1642.         push    dx
  1643.         push    si
  1644.         push    di
  1645. ;
  1646.         mov    ax, StdGrp
  1647.         mov    ds, ax
  1648. ;
  1649. ; See if either operand is zero:
  1650. ;
  1651.         mov    ax, fpacc.mantissa[0]    ;No need to check exponent!
  1652.         or    ax, fpacc.mantissa[2]
  1653.         or    ax, fpacc.mantissa[4]
  1654.         or    ax, fpacc.mantissa[6]
  1655.         jz    ProdIsZero
  1656. ;
  1657.         mov    ax, fpop.mantissa[0]
  1658.         or    ax, fpop.mantissa[2]
  1659.         or    ax, fpop.mantissa[4]
  1660.         or    ax, fpop.mantissa[6]
  1661.         jnz    ProdNotZero
  1662. ;
  1663. ProdIsZero:    xor    ax, ax            ;Need this!
  1664.         mov    fpacc.sign, al
  1665.         mov    fpacc.exponent, ax
  1666.         mov    fpacc.mantissa[0], ax
  1667.         mov    fpacc.mantissa[2], ax
  1668.         mov    fpacc.mantissa[4], ax
  1669.         mov    fpacc.mantissa[6], ax
  1670.         jmp    FMulDone
  1671. ;
  1672. ; If both operands are non-zero, compute the true product down here.
  1673. ;
  1674. ProdNotZero:    mov    al, fpop.sign        ;Compute the new sign.
  1675.         xor    fpacc.sign, al
  1676. ;
  1677. ; Eliminate bias in the exponents, add them, and check for 16-bit signed
  1678. ; overflow.
  1679. ;
  1680.         mov    ax, fpop.exponent    ;Compute new exponent.
  1681.         sub    ax, 7fffh        ;Subtract BIAS and adjust
  1682.         mov    bx, fpacc.Exponent
  1683.         sub    bx, 7fffh
  1684.         add    ax, bx            ; for fractional multiply.
  1685.         jno    GoodExponent
  1686. ;
  1687. ; If the exponent overflowed, set up the overflow value here.
  1688. ;
  1689.         mov    ax, 0ffffh
  1690.         mov    fpacc.exponent, ax    ;Largest exponent value
  1691.         mov    fpacc.mantissa[0], ax    ; and largest mantissa, too!
  1692.         mov    fpacc.mantissa[2], ax
  1693.         mov    fpacc.mantissa[4], ax
  1694.         mov    fpacc.mantissa[6], ax
  1695.         jmp    FMulDone
  1696. ;
  1697. GoodExponent:    add    ax, 8000h        ;Add the bias back in (note
  1698.         mov    fpacc.Exponent, ax    ; Mul64 below causes shift
  1699. ;                        ; to force bias of 7fffh.
  1700. ; Okay, compute the product of the mantissas down here.
  1701. ;
  1702.         call    Mul64
  1703. ;
  1704. ; Normalize the product.  Note: we know the product is non-zero because
  1705. ; both of the original operands were non-zero.
  1706. ;
  1707.         mov    cx, fpacc.exponent
  1708.         jmp    short TestNrmMul
  1709. NrmMul1:    sub    cx, 16
  1710.         mov    ax, fprod[12]
  1711.         mov    fprod[14], ax
  1712.         mov    ax, fprod[10]
  1713.         mov    fprod[12], ax
  1714.         mov    ax, fprod[8]
  1715.         mov    fprod[10], ax
  1716.         mov    ax, fprod[6]
  1717.         mov    fprod[8], ax
  1718.         mov    ax, fprod[4]
  1719.         mov    fprod[6], ax
  1720.         mov    ax, fprod[2]
  1721.         mov    fprod[4], ax
  1722.         mov    ax, fprod[0]
  1723.         mov    fprod[2], ax
  1724.         mov    fprod[0], 0
  1725. TestNrmMul:     cmp    cx, 16
  1726.         jb    DoNrmMul8
  1727.         mov      ax, fprod[14]
  1728.         or    ax, ax
  1729.         jz    NrmMul1
  1730. ;
  1731. ; See if we can shift the product a whole byte
  1732. ;
  1733. DoNrmMul8:    cmp    ah, 0            ;Contains fprod[15] from above.
  1734.         jnz    DoOneBits
  1735.         cmp    cx, 8
  1736.         jb    DoOneBits
  1737.         mov    ax, fprod[13]
  1738.         mov    fprod[14], ax
  1739.         mov    ax, fprod[11]
  1740.         mov    fprod[12], ax
  1741.         mov    ax, fprod[9]
  1742.         mov    fprod[10], ax
  1743.         mov    ax, fprod[7]
  1744.         mov    fprod[8], ax
  1745.         mov    ax, fprod[5]
  1746.         mov    fprod[6], ax
  1747.         mov    ax, fprod[3]
  1748.         mov    fprod[4], ax
  1749.         mov    ax, fprod[1]
  1750.         mov    fprod[2], ax
  1751.         mov    al, byte ptr fprod[0]
  1752.         mov    byte ptr fprod[1], al
  1753.         mov    byte ptr fprod[0], 0
  1754.         sub    cx, 8
  1755. ;
  1756. DoOneBits:    mov    ax, fprod[14]
  1757.         mov    bx, fprod[12]
  1758.         mov    dx, fprod[10]
  1759.         mov    si, fprod[8]
  1760.         mov    di, fprod[6]
  1761.         jmp    short TestOneBits
  1762. ;
  1763. OneBitLoop:    shl    fprod[0], 1
  1764.         rcl    fprod[2], 1
  1765.         rcl    fprod[4], 1
  1766.         rcl    di, 1
  1767.         rcl    si, 1
  1768.         rcl    dx, 1
  1769.         rcl    bx, 1
  1770.         rcl    ax, 1
  1771.         dec    cx
  1772. TestOneBits:    jcxz    StoreProd
  1773.         test    ah, 80h
  1774.         jz    OneBitLoop
  1775. ;
  1776. StoreProd:    mov    fpacc.mantissa[6], ax
  1777.         mov    fpacc.mantissa[4], bx
  1778.         mov    fpacc.mantissa[2], dx
  1779.         mov    fpacc.mantissa[0], si
  1780.         mov    fpacc.exponent, cx
  1781.         or    ax, bx
  1782.         or    ax, dx
  1783.         or    ax, si
  1784.         jnz    FMulDone
  1785. ;
  1786. ; If underflow occurs, set the result to zero.
  1787. ;
  1788.         mov    fpacc.exponent, ax
  1789.         mov    fpacc.sign, al
  1790. ;
  1791. FMulDone:    pop    di
  1792.         pop    si
  1793.         pop    dx
  1794.         pop    cx
  1795.         pop    bx
  1796.         pop    ax
  1797.         pop    ds
  1798.         ret
  1799. sl_fmul        endp
  1800.         assume    ds:nothing
  1801. ;
  1802. ;
  1803. ;
  1804. ;
  1805. ; Mul64- Multiplies the 8 bytes in fpacc.mant by the 8 bytes in fpop.mant
  1806. ;     and leaves the result in fprod.
  1807. ;
  1808. Mul64        proc    near
  1809.         assume    ds:StdGrp
  1810.         xor    ax, ax
  1811.         mov    fprod[0], ax
  1812.         mov    fprod[2], ax
  1813.         mov    fprod[4], ax
  1814.         mov    fprod[6], ax
  1815.         mov    fprod[8], ax
  1816.         mov    fprod[10], ax
  1817.         mov    fprod[12], ax
  1818.         mov    fprod[14], ax
  1819. ;
  1820. ; Computing the following (each character represents 16-bits):
  1821. ;
  1822. ;    A B C D
  1823. ;    x  E F G H
  1824. ;    -------
  1825. ;
  1826. ; Product is computed by:
  1827. ;
  1828. ;    A B C D
  1829. ;    x  E F G H
  1830. ;    ----------
  1831. ;            HD
  1832. ;        HC0
  1833. ;          HB00
  1834. ;      HA000
  1835. ;        GD0
  1836. ;          GC00
  1837. ;         GB000
  1838. ;        GA0000
  1839. ;          FD00
  1840. ;      FC000
  1841. ;        FB0000
  1842. ;       FA00000
  1843. ;         ED000
  1844. ;        EC0000
  1845. ;       EB00000
  1846. ;    + EA000000
  1847. ;    ----------
  1848. ;      xxxxxxxx
  1849. ;
  1850. ; In the loop below, si indexes through A, B, C, and D above (or E, F, G,
  1851. ; and H since multiplication is commutative).
  1852. ;
  1853.         mov    si, ax            ;Set Index to zero.
  1854. flp1:        mov    ax, fpacc.mantissa[si]    ;Multiply A, B, C, or D
  1855.         mul    fpop.mantissa[0]    ; by H.
  1856.         add    fprod [si], ax        ;Add it into the partial
  1857.         adc    fprod+2 [si], dx    ; product computed so far.
  1858.         jnc    NoCarry0
  1859.         inc    fprod+4 [si]
  1860.         jnz    NoCarry0
  1861.         inc    fprod+6 [si]
  1862.         jnz    NoCarry0
  1863.         inc    fprod+8 [si]
  1864.         jnz    NoCarry0
  1865.         inc    fprod+10 [si]
  1866.         jnz    NoCarry0
  1867.         inc    fprod+12 [si]
  1868.         jnz    NoCarry0
  1869.         inc    fprod+14 [si]
  1870. ;
  1871. NoCarry0:
  1872.         mov    ax, fpacc.mantissa[si]    ;Multiply A, B, C, or D
  1873.         mul    fpop.mantissa[2]    ; (selected by SI) by G
  1874.         add    fprod+2 [si], ax    ; and add it into the
  1875.         adc    fprod+4 [si], dx    ; partial product.
  1876.         jnc    NoCarry1
  1877.         inc    fprod+6 [si]
  1878.         jnz    NoCarry1
  1879.         inc    fprod+8 [si]
  1880.         jnz    NoCarry1
  1881.         inc    fprod+10 [si]
  1882.         jnz    NoCarry1
  1883.         inc    fprod+12 [si]
  1884.         jnz    NoCarry1
  1885.         inc    fprod [14]
  1886. ;
  1887. NoCarry1:
  1888.         mov    ax, fpacc.mantissa [si]    ;Multiply A, B, C, or D
  1889.         mul    fpop.mantissa [4]    ; (SI selects) by F and add
  1890.         add    fprod+4 [si], ax    ; it into the partial prod.
  1891.         adc    fprod+6 [si], dx
  1892.         jnc    NoCarry2
  1893.         inc    fprod+8 [si]
  1894.         jnz    NoCarry2
  1895.         inc    fprod+10 [si]
  1896.         jnz    NoCarry2
  1897.         inc    fprod+12 [si]
  1898.         jnz    NoCarry2
  1899.         inc    fprod+14 [si]
  1900. ;
  1901. NoCarry2:
  1902.         mov    ax, fpacc.mantissa [si]    ;Multiply A/B/C/D (selected
  1903.         mul    fpop.mantissa [6]    ; by SI) by E and add it
  1904.         add    fprod+6 [si], ax    ; into the partial product.
  1905.         adc    fprod+8 [si], dx
  1906.         jnc    NoCarry3
  1907.         inc    fprod+10 [si]
  1908.         jnz    NoCarry3
  1909.         inc    fprod+12 [si]
  1910.         jnz    NoCarry3
  1911.         inc    fprod+14 [si]
  1912. ;
  1913. NoCarry3:
  1914.         inc    si            ;Select next multiplier
  1915.         inc    si            ; (B, C, or D above).
  1916.         cmp    si, 8            ;Repeat for 64 bit x 64 bit
  1917.         jnb    QuitMul64        ; multiply.
  1918.         jmp    flp1
  1919. QuitMul64:    ret
  1920.         assume    ds:nothing
  1921. Mul64        endp
  1922. ;
  1923. ;
  1924. ;
  1925. ;
  1926. ;
  1927. ;
  1928. ;
  1929. ;
  1930. ;---------------------------------------------------------------------------
  1931. ;        Floating Point Division
  1932. ;---------------------------------------------------------------------------
  1933. ;
  1934. ;
  1935. ;
  1936. ;
  1937. ; Floating point division: Divides fpacc by fpop.
  1938. ;
  1939.         public    sl_fdiv
  1940. sl_fdiv        proc    far
  1941.         assume    ds:StdGrp
  1942.         push    ds
  1943.         push    ax
  1944.         push    bx
  1945.         push    cx
  1946.         push    dx
  1947.         push    si
  1948.         push    di
  1949.         push    bp
  1950. ;
  1951.         mov    ax, StdGrp
  1952.         mov    ds, ax
  1953. ;
  1954. ; See if either operand is zero:
  1955. ;
  1956.         mov    ax, fpacc.mantissa[0]    ;No need to check exponent!
  1957.         or    ax, fpacc.mantissa[2]
  1958.         or    ax, fpacc.mantissa[4]
  1959.         or    ax, fpacc.mantissa[6]
  1960.         jz    QuoIsZero
  1961. ;
  1962.         mov    ax, fpop.mantissa[0]
  1963.         or    ax, fpop.mantissa[2]
  1964.         or    ax, fpop.mantissa[4]
  1965.         or    ax, fpop.mantissa[6]
  1966.         jnz    DenomNotZero
  1967. ;
  1968. ; Whoops! Division by zero!  Set to largest possible value (+inf) and leave.
  1969. ;
  1970. DivOvfl:    mov    ax, 0ffffh
  1971.         mov    fpacc.exponent, ax
  1972.         mov    fpacc.mantissa[0], ax
  1973.         mov    fpacc.mantissa[2], ax
  1974.         mov    fpacc.mantissa[4], ax
  1975.         mov    fpacc.mantissa[6], ax
  1976.         mov    al, fpop.sign
  1977.         xor    fpacc.sign, al
  1978. ;
  1979. ; Note: we could also do an INT 0 (div by zero) or floating point exception
  1980. ; here, if necessary.
  1981. ;
  1982.         jmp    FDivDone
  1983. ;
  1984. ;
  1985. ; If the numerator is zero, the quotient is zero.  Handle that here.
  1986. ;
  1987. QuoIsZero:    xor    ax, ax            ;Need this!
  1988.         mov    fpacc.sign, al
  1989.         mov    fpacc.exponent, ax
  1990.         mov    fpacc.mantissa[0], ax
  1991.         mov    fpacc.mantissa[2], ax
  1992.         mov    fpacc.mantissa[4], ax
  1993.         mov    fpacc.mantissa[6], ax
  1994.         jmp    FDivDone
  1995. ;
  1996. ;
  1997. ;
  1998. ; If both operands are non-zero, compute the quotient down here.
  1999. ;
  2000. DenomNotZero:    mov    al, fpop.sign        ;Compute the new sign.
  2001.         xor    fpacc.sign, al
  2002. ;
  2003.         mov    ax, fpop.exponent    ;Compute new exponent.
  2004.         sub    ax, 7fffh        ;Subtract BIAS.
  2005.         mov    bx, fpacc.exponent
  2006.         sub    bx, 7fffh
  2007.         sub    bx, ax            ;Compute new exponent
  2008.         jo    DivOvfl
  2009.         add    bx, 7fffh        ;Add in BIAS
  2010.         mov    fpacc.exponent, bx    ;Save as new exponent.
  2011. ;
  2012. ; Okay, compute the quotient of the mantissas down here.
  2013. ;
  2014.         call    Div64
  2015. ;
  2016. ; Normalize the Quotient.
  2017. ;
  2018.         mov    cx, fpacc.exponent
  2019.         jmp    short TestNrmDiv
  2020. ;
  2021. ; Normalize by shifting 16 bits at a time here.
  2022. ;
  2023. NrmDiv1:    sub    cx, 16
  2024.         mov    ax, fpacc.mantissa[4]
  2025.         mov    fpacc.mantissa[6], ax
  2026.         mov    ax, fpacc.mantissa[2]
  2027.         mov    fpacc.mantissa[4], ax
  2028.         mov    ax, fpacc.mantissa[0]
  2029.         mov    fpacc.mantissa[2], ax
  2030.         mov    fpacc.mantissa[0], 0
  2031. TestNrmDiv:     cmp    cx, 16
  2032.         jb    DoNrmDiv8
  2033.         mov      ax, fpacc.mantissa[6]
  2034.         or    ax, ax
  2035.         jz    NrmDiv1
  2036. ;
  2037. ; Normalize by shifting eight bits at a time here.
  2038. ;
  2039. ; See if we can shift the product a whole byte
  2040. ;
  2041. DoNrmDiv8:    cmp    byte ptr fpacc.mantissa[7], 0
  2042.         jnz    DoOneBitsDiv
  2043.         cmp    cx, 8
  2044.         jb    DoOneBitsDiv
  2045.         mov    ax, fpacc.mantissa[5]
  2046.         mov    fpacc.mantissa[6], ax
  2047.         mov    ax, fpacc.mantissa[3]
  2048.         mov    fpacc.mantissa[4], ax
  2049.         mov    ax, fpacc.mantissa[1]
  2050.         mov    fpacc.mantissa[2], ax
  2051.         mov    al, byte ptr fpacc.mantissa[0]
  2052.         mov    byte ptr fpacc.mantissa[1], al
  2053.         mov    byte ptr fpacc.mantissa[0], 0
  2054.         sub    cx, 8
  2055. ;
  2056. DoOneBitsDiv:    mov    ax, fpacc.mantissa[6]
  2057.         mov    bx, fpacc.mantissa[4]
  2058.         mov    dx, fpacc.mantissa[2]
  2059.         mov    si, fpacc.mantissa[0]
  2060.         jmp    short TestOneBitsDiv
  2061. ;
  2062. ; One bit at a time normalization here.
  2063. ;
  2064. OneBitLoopDiv:    shl    si, 1
  2065.         rcl    dx, 1
  2066.         rcl    bx, 1
  2067.         rcl    ax, 1
  2068.         dec    cx
  2069. TestOneBitsDiv:    jcxz    StoreQuo
  2070.         test    ah, 80h
  2071.         jz    OneBitLoopDiv
  2072. ;
  2073. StoreQuo:    mov    fpacc.mantissa[6], ax
  2074.         mov    fpacc.mantissa[4], bx
  2075.         mov    fpacc.mantissa[2], dx
  2076.         mov    fpacc.mantissa[0], si
  2077.         mov    fpacc.exponent, cx
  2078.         or    ax, bx
  2079.         or    ax, dx
  2080.         or    ax, si
  2081.         jnz    FDivDone
  2082. ;
  2083. ; If underflow occurs, set the result to zero.
  2084. ;
  2085.         mov    fpacc.exponent, ax
  2086.         mov    fpacc.sign, al
  2087. ;
  2088. FDivDone:    pop    bp
  2089.         pop    di
  2090.         pop    si
  2091.         pop    dx
  2092.         pop    cx
  2093.         pop    bx
  2094.         pop    ax
  2095.         pop    ds
  2096.         ret
  2097. sl_fdiv        endp
  2098.         assume    ds:nothing
  2099. ;
  2100. ;
  2101. ;
  2102. ;
  2103. ; Div64- Divides the 64-bit fpacc.mantissa by the 64-bit fpop.mantissa.
  2104. ;
  2105. div64        proc    near
  2106.         assume    ds:StdGrp
  2107. ;
  2108. ;
  2109. ; First, normalize fpop if necessary and possible:
  2110. ;
  2111.         mov    ax, fpop.mantissa[6]
  2112.         mov    bx, fpop.mantissa[4]
  2113.         mov    cx, fpop.mantissa[2]
  2114.         mov    dx, fpop.mantissa[0]
  2115.         mov    si, fpacc.exponent
  2116.         jmp    short Div16NrmTest
  2117. ;
  2118. ; The following loop normalizes fpop 16 bits at a time.
  2119. ;
  2120. Div16NrmLp:    mov    ax, bx
  2121.         mov    bx, dx
  2122.         mov    cx, dx
  2123.         xor    dx, dx
  2124.         add    si, 16
  2125. Div16NrmTest:    cmp    si, -16
  2126.         ja    Div16Nrm8        ;Must be unsigned because this
  2127.         or    ax, ax            ; is bias arithmetic, not
  2128.         jz    Div16NrmLp        ; two's complement!
  2129. ;
  2130. ;
  2131. ; The following code checks to see if it can normalize by eight bits at
  2132. ; a time.
  2133. ;
  2134. Div16Nrm8:    cmp    si, -8
  2135.         ja    Div1NrmTest        ;Must be unsigned!
  2136.         cmp    ah, 0
  2137.         jnz    Div1NrmTest
  2138.         mov    ah, al
  2139.         mov    al, bh
  2140.         mov    bh, bl
  2141.         mov    bl, ch
  2142.         mov    ch, cl
  2143.         mov    cl, dh
  2144.         mov    dh, dl
  2145.         mov    dl, 0
  2146.         add    si, 8
  2147.         jmp    short Div1NrmTest
  2148. ;
  2149. ; Down here we're stuck with the slow task of normalizing by a bit
  2150. ; at a time.
  2151. ;
  2152. Div1NrmLp:    shl    dx, 1
  2153.         rcl    cx, 1
  2154.         rcl    bx, 1
  2155.         rcl    ax, 1
  2156.         inc    si
  2157. Div1NrmTest:    cmp    si, -1
  2158.         je    DivOvfl2        ;Can't do it!
  2159.         test    ah, 80h
  2160.         jz    Div1NrmLp
  2161.         jmp    short DoSlowDiv
  2162. ;
  2163. ; If overflow occurs, set FPACC to the maximum possible value and quit.
  2164. ;
  2165. DivOvfl2:    mov    ax, 0ffffh
  2166.         mov    fpacc.exponent, ax
  2167.         mov    fpacc.mantissa[0], ax
  2168.         mov    fpacc.mantissa[2], ax
  2169.         mov    fpacc.mantissa[4], ax
  2170.         mov    fpacc.mantissa[6], ax
  2171.         jmp    QuitDiv
  2172. ;
  2173. ; Oh No! A GawdAwful bit-by-bit division routine.  Terribly slow!
  2174. ; Actually, it was sped up a little by checking to see if it could
  2175. ; shift eight or sixteen bits at a time (because it encounters eight
  2176. ; or sixteen zeros during the division).
  2177. ;
  2178. ; Could possibly speed this up some more by checking for the special
  2179. ; case of n/16 bits.  Haven't tried this idea out though.
  2180. ;
  2181. DoSlowDiv:    mov    fpacc.exponent, si
  2182.         mov    si, ax
  2183.         mov    di, bx
  2184.         mov    fpop.mantissa[2], cx
  2185.         mov    fpop.mantissa[0], dx
  2186.         mov    ax, fpacc.mantissa[6]
  2187.         mov    bx, fpacc.mantissa[4]
  2188.         mov    cx, fpacc.mantissa[2]
  2189.         mov    dx, fpacc.mantissa[0]
  2190.         mov    bp, 64
  2191. DivideLoop:    cmp    bp, 16
  2192.         jb      Test8
  2193.         or    ax, ax
  2194.         jnz    Test8
  2195. ;
  2196. ; Do a shift by 16 bits here:
  2197. ;
  2198.         mov    ax, Quotient[4]
  2199.         mov    Quotient[6], ax
  2200.         mov    ax, Quotient[2]
  2201.         mov    Quotient[4], ax
  2202.         mov    ax, Quotient[0]
  2203.         mov    Quotient[2], ax
  2204.         mov    Quotient[0], 0
  2205.         mov    ax, bx
  2206.         mov    bx, cx
  2207.         mov    cx, dx
  2208.         xor    dx, dx
  2209.         sub    bp, 16
  2210.         jnz    DivideLoop
  2211.         jmp    FinishDivide
  2212. ;
  2213. Test8:        cmp    bp, 8
  2214.         jb      Do1
  2215.         cmp    ah, 0
  2216.         jnz    Do1
  2217. ;
  2218. ; Do a shift by 8 bits here:
  2219. ;
  2220.         push    ax
  2221.         mov    ax, Quotient[5]
  2222.         mov    Quotient[6], ax
  2223.         mov    ax, Quotient[3]
  2224.         mov    Quotient[4], ax
  2225.         mov    ax, Quotient[1]
  2226.         mov    Quotient[2], ax
  2227.         mov    al, byte ptr Quotient [0]
  2228.         mov    byte ptr Quotient [1], al
  2229.         mov    byte ptr Quotient[0], 0
  2230.         pop    ax
  2231.         mov    ah, al
  2232.         mov    al, bh
  2233.         mov    bh, bl
  2234.         mov    bl, ch
  2235.         mov    ch, cl
  2236.         mov    cl, dh
  2237.         mov    dh, dl
  2238.         mov    dl, 0
  2239.         sub    bp, 8
  2240.         jz    FinishDivide2
  2241.         jmp    DivideLoop
  2242. FinishDivide2:    jmp    FinishDivide
  2243. ;
  2244. Do1:        cmp    ax, si
  2245.         jb    shift0
  2246.         ja    Shift1
  2247.         cmp    bx, di
  2248.         jb    shift0
  2249.         ja    Shift1
  2250.         cmp    cx, fpop.mantissa[2]
  2251.         jb    shift0
  2252.         ja    shift1
  2253.         cmp    dx, fpop.mantissa[0]
  2254.         jb    shift0
  2255. ;
  2256. ; fpacc.mantiss IS greater than fpop.mantissa, shift a one bit into
  2257. ; the result here:
  2258. ;
  2259. Shift1:        stc
  2260.         rcl    Quotient[0], 1
  2261.         rcl    Quotient[2], 1
  2262.         rcl    Quotient[4], 1
  2263.         rcl    Quotient[6], 1
  2264.         sub    dx, fpop.mantissa[0]
  2265.         sbb    cx, fpop.mantissa[2]
  2266.         sbb    bx, di
  2267.         sbb    ax, si
  2268.         shl    dx, 1
  2269.         rcl    cx, 1
  2270.         rcl    bx, 1
  2271.         rcl    ax, 1            ;Never a carry out.
  2272.         dec    bp
  2273.         jnz    jDivideLoop
  2274.         jmp    FinishDivide
  2275. ;
  2276. ; If fpacc.mantissa was less than fpop.mantissa, shift a zero bit into
  2277. ; the quotient.
  2278. ;
  2279. Shift0:        shl    Quotient[0], 1
  2280.         rcl    Quotient[2], 1
  2281.         rcl    Quotient[4], 1
  2282.         rcl    Quotient[6], 1
  2283.         shl    dx, 1
  2284.         rcl    cx, 1
  2285.         rcl    bx, 1
  2286.         rcl    ax, 1
  2287.         jc    Greater
  2288.         dec    bp
  2289.         jnz    jDivideLoop
  2290.         jmp    FinishDivide
  2291. jDivideLoop:    jmp    DivideLoop
  2292. ;
  2293. ; If there was a carry out of the shift, we KNOW that fpacc must be
  2294. ; greater than fpop.  Handle that case down here.
  2295. ;
  2296. Greater:    dec    bp
  2297.         jz    FinishDivide
  2298.         stc
  2299.         rcl    Quotient[0], 1
  2300.         rcl    Quotient[2], 1
  2301.         rcl    Quotient[4], 1
  2302.         rcl    Quotient[6], 1
  2303.         sub    dx, fpop.mantissa[0]
  2304.         sbb    cx, fpop.mantissa[2]
  2305.         sbb    bx, di
  2306.         sbb    ax, si
  2307.         shl    dx, 1
  2308.         rcl    cx, 1
  2309.         rcl    bx, 1
  2310.         rcl    ax, 1
  2311.         jc    Greater
  2312.         dec    bp
  2313.         jz    FinishDivide
  2314.         jmp    DivideLoop
  2315. ;
  2316. ; Okay, clean everything up down here:
  2317. ;
  2318. FinishDivide:    mov    ax, Quotient[0]
  2319.         mov    fpacc.mantissa[0], ax
  2320.         mov    ax, Quotient[2]
  2321.         mov    fpacc.mantissa[2], ax
  2322.         mov    ax, Quotient[4]
  2323.         mov    fpacc.mantissa[4], ax
  2324.         mov    ax, Quotient[6]
  2325.         mov    fpacc.mantissa[6], ax
  2326. ;
  2327. QuitDiv:    ret
  2328.         assume    ds:nothing
  2329. div64        endp
  2330. ;
  2331. ;
  2332. ;
  2333. ;
  2334. ;
  2335. ;---------------------------------------------------------------------------
  2336. ;        Floating Point => TEXT (Output) conversion routines.
  2337. ;---------------------------------------------------------------------------
  2338. ;
  2339. ;
  2340. ;
  2341. ;
  2342. ; Power of ten tables used by the floating point I/O routines.
  2343. ;
  2344. ; Format for each entry (13 bytes):
  2345. ;
  2346. ; 1st through
  2347. ; 11th bytes    Internal FP format for this particular number.
  2348. ;
  2349. ; 12th &
  2350. ; 13th bytes:    Decimal exponent for this value.
  2351. ;
  2352. ;
  2353. ; This first table contains the negative powers of ten as follows:
  2354. ;
  2355. ;   for n:= 0 to 12 do
  2356. ;    entry [12-n] := 10 ** (-2 ** n)
  2357. ;   entry [13] := 1.0
  2358. ;
  2359. PotTbln         dw    9fdeh, 0d2ceh, 4c8h, 0a6ddh, 4ad8h    ; 1e-4096
  2360.         db    0                    ; Sign
  2361.         dw    -4096                    ; Dec Exponent
  2362. ;
  2363.         dw    2de4h, 3436h, 534fh, 0ceaeh, 656bh    ; 1e-2048
  2364.         db    0
  2365.         dw    -2048
  2366. ;
  2367.         dw    0c0beh, 0da57h, 82a5h, 0a2a6h, 72b5h    ; 1e-1024
  2368.         db    0
  2369.         dw    -1024
  2370. ;
  2371.         dw    0d21ch, 0db23h, 0ee32h, 9049h, 795ah    ; 1e-512
  2372.         db    0
  2373.         dw    -512
  2374. ;
  2375.         dw    193ah, 637ah, 4325h, 0c031h, 7cach    ; 1e-256
  2376.         db    0
  2377.         dw    -256
  2378. ;
  2379.         dw    0e4a1h, 64bch, 467ch, 0ddd0h, 7e55h    ; 1e-128
  2380.         db    0
  2381.         dw    -128
  2382. ;
  2383.         dw    0e9a5h, 0a539h, 0ea27h, 0a87fh, 7f2ah    ; 1e-64
  2384.         db    0
  2385.         dw    -64
  2386. ;
  2387.         dw    94bah, 4539h, 1eadh, 0cfb1h, 7f94h    ; 1e-32
  2388.         db    0
  2389.         dw    -32
  2390. ;
  2391.         dw    0e15bh, 0c44dh, 94beh, 0e695h, 7fc9h    ; 1e-16
  2392.         db    0
  2393.         dw    -16
  2394. ;
  2395.         dw    0cefdh, 8461h, 7711h, 0abcch, 7fe4h    ; 1e-8
  2396.         db    0
  2397.         dw    -8
  2398. ;
  2399.         dw    652ch, 0e219h, 1758h, 0d1b7h, 7ff1h    ; 1e-4
  2400.         db    0
  2401.         dw    -4
  2402. ;
  2403.         dw    0d70ah, 70a3h, 0a3dh, 0a3d7h, 7ff8h    ; 1e-2
  2404.         db    0
  2405.         dw    -2
  2406. ;
  2407. Div10Value    dw    0cccdh, 0cccch, 0cccch, 0cccch, 7ffbh    ; 1e-1
  2408.         db    0
  2409.         dw    -1
  2410. ;
  2411.         dw    0, 0, 0, 8000h, 7fffh            ; 1e0
  2412.         db    0
  2413.         dw    0
  2414. ;
  2415. ;
  2416. ; PotTblP- Power of ten table.  Holds powers of ten raised to positive
  2417. ;       powers of two;
  2418. ;
  2419. ;        i.e., x(12-n) = 10 ** (2 ** n) for 0 <= n <= 12.
  2420. ;              x(13) = 1.0
  2421. ;              x(-1) = 10 ** (2 ** -4096)
  2422. ;
  2423. ; There is a -1 entry since it is possible for the algorithm to back up
  2424. ; before the table.
  2425. ;
  2426.         dw    979bh, 8a20h, 5202h, 0c460h, 0b525h    ; 1e+4096
  2427.         db    0
  2428.         dw    4096
  2429. ;
  2430. PotTblP        dw    979bh, 8a20h, 5202h, 0c460h, 0b525h    ; 1e+4096
  2431.         db    0
  2432.         dw    4096
  2433. ;
  2434.         dw    5de5h, 0c53dh, 3b5dh, 9e8bh, 09a92h    ; 1e+2048
  2435.         db    0
  2436.         dw    2048
  2437. ;
  2438.         dw    0c17h, 8175h, 7586h, 0c976h, 08d48h    ; 1e+1024
  2439.         db    0
  2440.         dw    1024
  2441. ;
  2442.         dw    91c7h, 0a60eh, 0a0aeh, 0e319h, 086a3h    ; 1e+512
  2443.         db    0
  2444.         dw    512
  2445. ;
  2446.         dw    0de8eh, 9df9h, 0ebfbh, 0aa7eh, 08351h    ; 1e+256
  2447.         db    0
  2448.         dw    256
  2449. ;
  2450.         dw    8ce0h, 80e9h, 47c9h, 93bah, 081a8h    ; 1e+128
  2451.         db    0
  2452.         dw    128
  2453. ;
  2454.         dw    0a6d5h, 0ffcfh, 1f49h, 0c278h, 080d3h    ; 1e+64
  2455.         db    0
  2456.         dw    64
  2457. ;
  2458.         dw    0b59eh, 2b70h, 0ada8h, 9dc5h, 08069h    ; 1e+32
  2459.         db    0
  2460.         dw    32
  2461. ;
  2462.         dw    0, 400h, 0c9bfh, 8e1bh, 08034h        ; 1e+16
  2463.         db    0
  2464.         dw    16
  2465. ;
  2466.         dw    0, 0, 2000h, 0bebch, 08019h        ; 1e+8
  2467.         db    0
  2468.         dw    8
  2469. ;
  2470.         dw    0, 0, 0, 9c40h, 0800ch            ; 1e+4
  2471.         db    0
  2472.         dw    4
  2473. ;
  2474.         dw    0, 0, 0, 0c800h, 08005h            ; 1e+2
  2475.         db    0
  2476.         dw    2
  2477. ;
  2478.         dw    0, 0, 0, 0a000h, 08002h            ; 1e+1
  2479.         db    0
  2480.         dw    1
  2481. ;
  2482.         dw    0, 0, 0, 8000h, 7fffh            ; 1e0
  2483.         db    0
  2484.         dw    0
  2485. ;
  2486. ;
  2487. ;
  2488. ;
  2489. ;
  2490. ;
  2491. ;
  2492. ; SL_FTOA-    Converts extended precision value in FPACC to a decimal
  2493. ;        string.  AL contains the field width, AH contains the
  2494. ;        number of positions after the decimal point.  The format
  2495. ;        of the converted string is:
  2496. ;
  2497. ;            sd.e
  2498. ;
  2499. ;        where "s" is a single character which is either a space
  2500. ;        or "=", "e" is some number of digits which is equal to
  2501. ;        the value passed in AL, and "d" is the number of digits
  2502. ;        given by  (AL-AH-2).  If the field width is too small,
  2503. ;        this routine creates a string of "#" characters AH long.
  2504. ;
  2505. ;        ES:DI contains the address where we're supposed to put
  2506. ;        the resulting string.  This code assumes that there is
  2507. ;        sufficient memory to hold (AL+1) characters at this address.
  2508. ;
  2509. ;
  2510. ;
  2511.         public    sl_ftoa
  2512. sl_ftoa        proc    far
  2513.         push    di
  2514.         call    far ptr sl_ftoa2
  2515.         pop    di
  2516.         ret
  2517. sl_ftoa        endp
  2518. ;
  2519.         public    sl_ftoa2
  2520. sl_ftoa2    proc    far
  2521.         assume    ds:StdGrp
  2522. ;
  2523.         pushf
  2524.         push    ds
  2525.         push    ax
  2526.         push    bx
  2527.         push    cx
  2528.         push    dx
  2529.         push    si
  2530. ;
  2531.         cld
  2532.         mov    bx, StdGrp
  2533.         mov    ds, bx
  2534. ;
  2535. ; Save fpacc 'cause it gets munged.
  2536. ;
  2537.         push    fpacc.Mantissa [0]
  2538.         push    fpacc.Mantissa [2]
  2539.         push    fpacc.Mantissa [4]
  2540.         push    fpacc.Mantissa [6]
  2541.         push    fpacc.Exponent
  2542.         push    word ptr fpacc.Sign
  2543. ;
  2544.         mov    cx, ax        ;Save field width/dec pts here.
  2545. ;
  2546.         call    fpdigits    ;Convert fpacc to digit string.
  2547. ;
  2548. ; Round the string of digits to the number of significant digits we want to
  2549. ; display for this number:
  2550. ;
  2551.         mov    bx, DecExponent
  2552.         cmp    bx, 18
  2553.         jb    PosRS
  2554.         xor    bx, bx        ;Force to zero if negative or too big.
  2555. ;
  2556. PosRS:        add    bl, ch               ;Compute position where we should start
  2557.         adc    bh, 0        ; the rounding.
  2558.         inc    bx        ;Tweak next digit.
  2559.         cmp    bx, 18        ;Don't bother rounding if we have
  2560.         jae    RoundDone    ; more than 18 digits here.
  2561. ;
  2562. ; Add 5 to the digit after the last digit we want to print.  Then propogate
  2563. ; any overflow through the remaining digits.
  2564. ;
  2565.         mov    al, DecDigits [bx]
  2566.         add    al, 5
  2567.         mov    DecDigits [bx], al
  2568.         cmp    al, "9"
  2569.         jbe     RoundDone
  2570.         sub    DecDigits [bx], 10
  2571. RoundLoop:    dec    bx
  2572.         js    FirstDigit
  2573.         inc    DecDigits[bx]
  2574.         cmp    DecDigits[bx], "9"
  2575.         jbe    RoundDone
  2576.         sub    DecDigits[bx], 10
  2577.         jmp    RoundLoop
  2578. ;
  2579. ; If we hit the first digit in the string, we've got to shift all the
  2580. ; characters down one position and put a "1" in the first character
  2581. ; position.
  2582. ;
  2583. FirstDigit:     mov    bx, DecExponent
  2584.         cmp    bx, 18
  2585.         jb    FDOkay
  2586.         xor    bx, bx
  2587. ;
  2588. FDOkay:        mov    bl, ch
  2589.         mov    bh, 0
  2590.         inc    bx
  2591. FDLp:        mov    al, byte ptr DecDigits[bx-1]
  2592.         mov    DecDigits [bx], al
  2593.         dec    bx
  2594.         jnz    FDLp
  2595.         mov    DecDigits, "1"
  2596.         inc    DecExponent    ;Cause we just added a digit.
  2597. ;
  2598. RoundDone:
  2599. ;
  2600. ; See if we're dealing with values greater than one (abs) or between 0 & 1.
  2601. ;
  2602.         cmp    DecExponent, 0    ;Handle positive/negative exponents
  2603.         jge    PositiveExp    ; separately.
  2604. ;
  2605. ; Handle values between 0 & 1 here (negative powers of ten).
  2606. ;
  2607.         mov    dl, ch        ;Compute #'s width = DecPlaces+3
  2608.         add       dl, 3        ;Make room for "-0."
  2609.         jc    BadFieldWidth
  2610.         cmp    dl, 4
  2611.         jae    LengthOk
  2612.         mov    dl, 4        ;Minimum string is "-0.0"
  2613. LengthOK:    mov    al, ' '
  2614. PutSpcs2:       cmp    dl, cl
  2615.         jae    PS2Done
  2616.         stosb
  2617.         inc    dl
  2618.         jmp    PutSpcs2
  2619. ;
  2620. PS2Done:           mov    al, DecSign
  2621.         stosb
  2622.         mov    al, "0"        ;Output "0." before the number.
  2623.         stosb
  2624.         mov    al, "."
  2625.         stosb
  2626.         mov    ah, 0        ;Used to count output digits
  2627.         lea    bx, stdGrp:DecDigits ;Pointer to number string.
  2628. PutDigits2:    inc    DecExponent
  2629.         jns    PutTheDigit
  2630. ;
  2631. ; If the exponent value is still negative, output zeros because we've yet
  2632. ; to reach the beginning of the number.
  2633. ;
  2634. PutZero2:    mov    al, '0'
  2635.         stosb
  2636.         jmp    TestDone2
  2637. ;
  2638. PutTheDigit:    cmp    ah, 18        ;If more than 18 digits so far, just
  2639.         jae    PutZero2    ; output zeros.
  2640. ;
  2641.         mov    al, [bx]
  2642.         inc    bx
  2643.         stosb
  2644. ;
  2645. TestDone2:    inc    ah
  2646.         dec    ch
  2647.         jnz     PutDigits2
  2648.         mov    byte ptr es:[di], 0
  2649.         jmp    ftoaDone
  2650. ;
  2651. ;
  2652. ; Okay, we've got a positive exponent here.  First, let's adjust the field
  2653. ; width value (in CH) so that it includes the sign and possible decimal point.
  2654. ;
  2655. PositiveExp:    mov    dx, DecExponent    ;Get actual # of digits to left of "."
  2656.         inc    dx        ;Allow for sign and the fact that there
  2657.         inc    dx        ; is always one digit to left of ".".
  2658.         cmp    ch, 0        ;# of chars after "." = 0?
  2659.         je    NoDecPt
  2660.         add    dl, ch        ;Add in number of chars after "."
  2661.         adc    dh, 0
  2662.         inc    dx        ;Make room for "."
  2663. NoDecPt:
  2664. ;
  2665. ;
  2666. ; Make sure the field width is bigger than the number of decimal places to
  2667. ; print.
  2668. ;
  2669.         cmp    cl, ch
  2670.         jb    BadFieldWidth
  2671. ;
  2672. ;
  2673. ; Okay, now see if the user is trying to print a value which is too large
  2674. ; to fit in the given field width:
  2675. ;
  2676.         cmp    dh, 0
  2677.         jne    BadFieldWidth    ;Sorry, no output >= 256 chars.
  2678.         cmp    dl, cl        ;Need field width > specified FW?
  2679.         jbe    GoodFieldWidth
  2680. ;
  2681. ; If we get down here, then we've got a number which will not fit in the
  2682. ; specified field width.  Fill the string with #'s (sorta like FORTRAN).
  2683. ;
  2684. BadFieldWidth:    mov    ch, 0        ;Set CX=field width.
  2685.         mov    al, "#"
  2686.     rep    stosb
  2687.         mov    byte ptr es:[di], 0
  2688.         jmp    ftoaDone
  2689. ;
  2690. ;
  2691. ; Print any necessary spaces in front of the number.
  2692. ;
  2693. GoodFieldWidth:    call    PutSpaces
  2694. ;
  2695. ; Output the sign character (" " or "-"):
  2696. ;
  2697.         mov    al, DecSign
  2698.         stosb
  2699. ;
  2700. ; Okay, output the digits for this number here.
  2701. ;
  2702.         mov    ah, 0        ;Counts off output characters.
  2703.         lea    bx, stdgrp:DecDigits ;Pointer to digit string.
  2704.         mov    cl, ch        ;CX := # of chars after "."
  2705.         mov    ch, 0               ; plus number of characters before
  2706.         add    cx, DecExponent    ; the ".".
  2707.         inc    cx        ;Always at least one digit before "."
  2708. OutputLp:    cmp    ah, 18        ;Exceeded 18 digits?
  2709.         jae    PutZeros
  2710.         mov    al, [bx]
  2711.         inc    bx
  2712.         jmp    PutChar
  2713. ;
  2714. PutZeros:    mov    al, '0'
  2715. PutChar:    stosb
  2716.         cmp    DecExponent, 0
  2717.         jne    DontPutPoint
  2718.         mov    al, '.'
  2719.         stosb
  2720. ;
  2721. DontPutPoint:    dec    DecExponent
  2722.         inc    ah
  2723.         loop    OutputLp
  2724.         mov    byte ptr es:[di], 0     ;Output the zero byte.
  2725. ;
  2726. ftoaDone:    pop    word ptr fpacc.Sign
  2727.         pop    fpacc.Exponent
  2728.         pop    fpacc.Mantissa [6]
  2729.         pop    fpacc.Mantissa [4]
  2730.         pop    fpacc.Mantissa [2]
  2731.         pop    fpacc.Mantissa [0]
  2732.         pop    si
  2733.         pop    dx
  2734.         pop    cx
  2735.         pop    bx
  2736.         pop    ax
  2737.         pop    ds
  2738.         popf
  2739.         ret
  2740. sl_ftoa2    endp
  2741. ;
  2742. ;
  2743. ;
  2744. ;
  2745. ; Okay, now we need to insert any necessary leading spaces.  We need to
  2746. ; put (FieldWidth - ActualWidth) spaces before the string of digits.
  2747. ;
  2748. PutSpaces    proc    near
  2749.         cmp    dl, cl        ;See if print width >= field width
  2750.         jae    NoSpaces
  2751.         mov    ah, cl
  2752.         sub    ah, dl        ;Compute # of spaces to print.
  2753.         mov    al, ' '
  2754. PSLp:        stosb
  2755.         dec    ah
  2756.         jnz    PSLp
  2757. NoSpaces:    ret
  2758. PutSpaces    endp
  2759. ;
  2760. ;
  2761. ;
  2762. ;
  2763. ;
  2764. ;
  2765. ;
  2766. ;
  2767. ;
  2768. ;
  2769. ;
  2770. ;
  2771. ;
  2772. ;
  2773. ; SL_ETOA-    Converts value in FPACC to exponential form.  AL contains
  2774. ;        the number of print positions.  ES:DI points to the array
  2775. ;        which will hold this string (it must be at least AL+1 chars
  2776. ;        long).
  2777. ;
  2778. ;        The output string takes the format:
  2779. ;
  2780. ;        {" "|-} [0-9] "." [0-9]* "E" [+|-] [0-9]{2,4}
  2781. ;
  2782. ;        (The term "[0-9]{2,4}" means either two or four digits)
  2783. ;
  2784. ;        AL must be at least eight or this code outputs #s.
  2785. ;
  2786.         public    sl_etoa
  2787. sl_etoa        proc    far
  2788.         push    di
  2789.         call    far ptr sl_etoa2
  2790.         pop    di
  2791.         ret
  2792. sl_etoa        endp
  2793. ;
  2794. ;
  2795.         public    sl_etoa2
  2796. sl_etoa2    proc    far
  2797.         assume    ds:StdGrp
  2798. ;
  2799.         pushf
  2800.         push    ds
  2801.         push    ax
  2802.         push    bx
  2803.         push    cx
  2804.         push    si
  2805. ;
  2806.         cld
  2807.         mov    bx, StdGrp
  2808.         mov    ds, bx
  2809. ;
  2810.         push    fpacc.Mantissa [0]
  2811.         push    fpacc.Mantissa [2]
  2812.         push    fpacc.Mantissa [4]
  2813.         push    fpacc.Mantissa [6]
  2814.         push    fpacc.Exponent
  2815.         push    word ptr fpacc.Sign
  2816. ;
  2817.         call    fpdigits
  2818. ;
  2819. ; See if we have sufficient room for the number-
  2820. ;
  2821.         mov    ah, 0
  2822.         mov    cx, ax
  2823. ;
  2824. ; Okay, take out spots for sign, ".", "E", sign, and at least four exponent
  2825. ; digits and the exponent's sign:
  2826. ;
  2827. Subtract2:    sub    ax, 8
  2828.         jc    BadEWidth
  2829.         jnz    DoTheRound    ;Make sure at least 1 digit left!
  2830. ;
  2831. BadEWidth:    mov    ch, 0
  2832.         mov    al, "#"
  2833.     rep    stosb
  2834.         mov    al, 0
  2835.         stosb
  2836.         jmp    etoaDone
  2837. ;
  2838. ; Round the number to the specified number of places.
  2839. ;
  2840. DoTheRound:    mov    ch, al        ;# of decimal places is # of posns.
  2841.         mov    bl, ch               ;Compute position where we should start
  2842.         mov    bh, 0        ; the rounding.
  2843.         cmp    bx, 18        ;Don't bother rounding if we have
  2844.         jae    eRoundDone    ; more than 18 digits here.
  2845. ;
  2846. ; Add 5 to the digit after the last digit we want to print.  Then propogate
  2847. ; any overflow through the remaining digits.
  2848. ;
  2849.         mov    al, DecDigits [bx]
  2850.         add    al, 5
  2851.         mov    DecDigits [bx], al
  2852.         cmp    al, "9"
  2853.         jbe     eRoundDone
  2854.         sub    DecDigits [bx], 10
  2855. eRoundLoop:    dec    bx
  2856.         js    eFirstDigit
  2857.         inc    DecDigits[bx]
  2858.         cmp    DecDigits[bx], "9"
  2859.         jbe    eRoundDone
  2860.         sub    DecDigits[bx], 10
  2861.         jmp    eRoundLoop
  2862. ;
  2863. ; If we hit the first digit in the string, we've got to shift all the
  2864. ; characters down one position and put a "1" in the first character
  2865. ; position.
  2866. ;
  2867. eFirstDigit:    mov    bl, ch
  2868.         mov    bh, 0
  2869.         inc    bx
  2870. eFDLp:        mov    al, byte ptr DecDigits[bx-1]
  2871.         mov    DecDigits [bx], al
  2872.         dec    bx
  2873.         jnz    eFDLp
  2874.         mov    DecDigits, "1"
  2875.         inc    DecExponent    ;Cause we just added a digit.
  2876. ;
  2877. eRoundDone:
  2878. ;
  2879. ; Okay, output the value here.
  2880. ;
  2881.         mov    cl, ch        ;Set CX=Number of output chars
  2882.         mov    ch, 0
  2883.         mov    al, DecSign
  2884.         stosb
  2885.         lea    si, stdgrp:DecDigits
  2886.         movsb            ;Output first char.
  2887.         dec    cx        ;See if we're done!
  2888.         jz    PutExponent
  2889. ;
  2890. ; Output the fractional part here
  2891. ;
  2892.         mov    al, "."
  2893.         stosb
  2894.         mov    ah, 17        ;Max # of chars to output.
  2895. PutFractional:    cmp    ah, 0
  2896.         jz    NoMoreDigs
  2897.         movsb
  2898.         dec    ah
  2899.         jmp    NextFraction
  2900. ;
  2901. ; If we've output more than 18 digits, just output zeros.
  2902. ;
  2903. NoMoreDigs:    mov    al, "0"
  2904.         stosb
  2905. ;
  2906. NextFraction:    loop    PutFractional
  2907. PutExponent:    mov    al, "E"
  2908.         stosb
  2909.         mov    al, "+"
  2910.         cmp    DecExponent, 0
  2911.         jge    NoNegExp
  2912.         mov    al, "-"
  2913.         neg    DecExponent
  2914. ;
  2915. NoNegExp:    stosb
  2916.         mov    ax, DecExponent
  2917.         cwd            ;Sets DX := 0.
  2918.         mov    cx, 1000
  2919.         div    cx
  2920.         or    al, "0"
  2921.         stosb            ;Output 1000's digit
  2922.         xchg    ax, dx
  2923.         cwd
  2924.         mov    cx, 100
  2925.         div    cx
  2926.         or    al, "0"        ;Output 100's digit
  2927.         stosb
  2928.         xchg    ax, dx
  2929.         cwd
  2930.         mov    cx, 10
  2931.         div    cx
  2932.         or    al, "0"        ;Output 10's digit
  2933.         stosb
  2934.         xchg    ax, dx
  2935.         or    al, "0"        ;Output 1's digit
  2936.         stosb
  2937.         mov    byte ptr es:[di], 0    ;Output zero byte.
  2938. ;
  2939. etoaDone:    pop    word ptr fpacc.Sign
  2940.         pop    fpacc.Exponent
  2941.         pop    fpacc.Mantissa [6]
  2942.         pop    fpacc.Mantissa [4]
  2943.         pop    fpacc.Mantissa [2]
  2944.         pop    fpacc.Mantissa [0]
  2945.         pop    si
  2946.         pop    cx
  2947.         pop    bx
  2948.         pop    ax
  2949.         pop    ds
  2950.         popf
  2951.         ret
  2952. sl_etoa2    endp
  2953. ;
  2954. ;
  2955. ;
  2956. ;
  2957. ;
  2958. ; FPDigits- Converts the floating point number in FPACC to a string of
  2959. ;        digits (in DecDigits), an integer exponent value (DecExp),
  2960. ;        and a sign character (DecSign).  The decimal point is assumed
  2961. ;        to be between the first and second characters in the string.
  2962. ;
  2963. FPDigits    proc    near
  2964.         assume    ds:StdGrp
  2965.         push    ds
  2966.         push    ax
  2967.         push    bx
  2968.         push    cx
  2969.         push    dx
  2970.         push    di
  2971.         push    si
  2972. ;
  2973.         mov    ax, seg StdGrp
  2974.         mov    ds, ax
  2975. ;
  2976. ; First things first, see if this value is zero:
  2977. ;
  2978.         mov    ax, fpacc.Mantissa [0]
  2979.         or    ax, fpacc.Mantissa [2]
  2980.         or    ax, fpacc.Mantissa [4]
  2981.         or    ax, fpacc.Mantissa [6]
  2982.         jnz    fpdNotZero
  2983. ;
  2984. ; Well, it's zero.  Handle this as a special case:
  2985. ;
  2986.         mov    ax, 3030h        ;"00"
  2987.         mov    word ptr DecDigits[0], ax
  2988.         mov    word ptr DecDigits[2], ax
  2989.         mov    word ptr DecDigits[4], ax
  2990.         mov    word ptr DecDigits[6], ax
  2991.         mov    word ptr DecDigits[8], ax
  2992.         mov    word ptr DecDigits[10], ax
  2993.         mov    word ptr DecDigits[12], ax
  2994.         mov    word ptr DecDigits[14], ax
  2995.         mov    word ptr DecDigits[16], ax
  2996.         mov    word ptr DecDigits[18], ax
  2997.         mov    word ptr DecDigits[20], ax
  2998.         mov    word ptr DecDigits[22], ax
  2999.         mov    DecExponent, 0
  3000.         mov    DecSign, ' '
  3001.         jmp    fpdDone
  3002. ;
  3003. ; If the number is not zero, first fix up the sign:
  3004. ;
  3005. fpdNotZero:    mov    DecSign, ' '        ;Assume it's postive
  3006.         cmp    fpacc.Sign, 0
  3007.         jns    WasPositive
  3008.         mov    DecSign, '-'
  3009.         mov    fpacc.Sign, 0        ;Take ABS(fpacc).
  3010. ;
  3011. ; This conversion routine is fairly standard.  See Neil Graham's
  3012. ; "Microprocessor Programming for Computer Hobbyists" for the gruesome
  3013. ; details.  Basically, it first gets the number between 1 & 10 by successively
  3014. ; multiplying (or dividing) by ten.  For each multiply by 10 this code
  3015. ; decrements DecExponent by one.  For each division by ten this code
  3016. ; increments DecExponent by one.  Upon getting the value between 1 & 10
  3017. ; DecExponent contains the integer equivalent of the exponent.  The
  3018. ; following code does this.
  3019. ;
  3020. ; Note: if the value falls between 1 & 10, then the exponent portion of
  3021. ;    fpacc will lie between 7fffh and 8002h.
  3022. ;
  3023. WasPositive:    mov    DecExponent, 0        ;Initialize exponent.
  3024. ;
  3025. ; Quick test to see if we're already less than 10.
  3026. ;
  3027. WhlBgrThan10:    cmp    fpacc.Exponent, 8002h    ;See if fpacc > 10
  3028.         jb    WhlLessThan1
  3029.         ja    IsGtrThan10
  3030. ;
  3031. ; If the exponent is equal to 8002h, then we could have a number in the
  3032. ; range 8 <= n < 16.  Let's ignore values less than 10.
  3033. ;
  3034.         cmp    byte ptr fpacc.Mantissa [7], 0a0h
  3035.         jb    WhlLessThan1
  3036. ;
  3037. ; If it's bigger than ten we could perform successive divisions by ten.
  3038. ; This, however, would be slow, inaccurate, and disgusting.  The following
  3039. ; loop skips through the positive powers of ten (PotTblP) until it finds
  3040. ; someone with an exponent *less* than fpacc.  Upon finding such a value,
  3041. ; this code divides fpacc by the corresponding entry in PotTblN.  This is
  3042. ; equivalent to *dividing* by the entry in PotTblP.  Note: this code only
  3043. ; compares exponents.  Therefore, it is quite possible that we will divide
  3044. ; by a number slightly larger than fpacc (since the mantissa of the table
  3045. ; entry could be larger than the mantissa of fpacc while their exponents
  3046. ; are equal).  This will produce a result slightly less than one.  This is
  3047. ; okay in this case because the code which handles values between 0 & 1
  3048. ; follows and will correct this oversight.
  3049. ;
  3050. IsGtrThan10:    mov    bx, -13            ;Index into PotTblP
  3051.         mov    ax, fpacc.Exponent
  3052. WhlBgrLp1:    add    bx, 13
  3053.         cmp    ax, PotTblP [bx] + 8    ;Compare exponent values.
  3054.         jb    WhlBgrLp1        ;Go to next entry if less.
  3055.  
  3056. ; Okay, we found the first table entry whose exponent is less than or
  3057. ; equal to the fpacc exponent.  Multiply by the corresonding PotTblN
  3058. ; value here (which simulates a divide).
  3059.  
  3060.  
  3061.         call    nTbl2FPOP
  3062.         mov    ax, PotTblP [bx] + 11    ;Adjust DecExponent
  3063.         add    DecExponent, ax
  3064.         call    sl_fMUL            ;Divide by appropriate power.
  3065.         mov    ax, fpacc.Exponent
  3066.         cmp    ax, 8002h        ;See if fpacc > 10
  3067.         ja    WhlBgrLp1
  3068.         jb    WhlLessThan1
  3069.  
  3070. ; If the exponent is equal to 8002h, then we could have a number in the
  3071. ; range 8 <= n < 16.  Let's ignore values less than 10.
  3072.  
  3073.         cmp    byte ptr fpacc.Mantissa [7], 0a0h
  3074.         jae    WhlBgrLp1
  3075.  
  3076. ; Once we get the number below 10 (or if it was below 10 to begin with,
  3077. ; drop down here and boost it up to the point where it is >= 1.
  3078. ;
  3079. ; This code is similar to the above-  It successively multiplies by 10
  3080. ; (actually, powers of ten) until the number is in the range 1..10.
  3081. ; This code is not as sloppy as the code above because we don't have any
  3082. ; code below this to clean up the sloppiness.  Indeed, this code has to
  3083. ; be careful because it is cleaning up the sloppiness of the code above.
  3084. ;
  3085. ;
  3086. WhlLessThan1:    cmp    fpacc.Exponent, 7fffh    ;See if fpacc < 1
  3087.         jae    NotLessThan1
  3088. ;
  3089.         mov    bx, -13            ;Index into PotTblN
  3090. WhlLessLp2:    mov    ax, fpacc.Exponent
  3091. WhlLessLp1:    add    bx, 13
  3092.         cmp    ax, PotTblN [bx] + 8    ;Compare exponent values.
  3093.         ja    WhlLessLp1        ;Go to next entry if less.
  3094. ;
  3095. ; Okay, we found the first table entry whose exponent is greater than or
  3096. ; equal to the fpacc exponent.  Unlike the code above, we cannot simply
  3097. ; multiply by the corresponding entry in PotTblP at this point.  If the
  3098. ; exponents were equal, we need to compare the mantissas and make sure we're
  3099. ; not multiplying by a table entry which is too large.
  3100. ;
  3101.         jne    OkayToMultiply
  3102. ;
  3103. ; If the exponents are the same, we need to compare the mantissas.  The
  3104. ; table entry cannot be larger than fpacc;  if it is, we'll wind up with
  3105. ; an endless loop oscillating between a couple of values.
  3106. ;
  3107.         mov    ax, fpacc.Mantissa [6]
  3108.         cmp    ax, PotTblN [bx] + 6
  3109.         ja      WhlLessLp2
  3110.         jb    OkayToMultiply
  3111.         mov    ax, fpacc.Mantissa [4]
  3112.         cmp    ax, PotTblN [bx] + 4
  3113.         ja    WhlLessLp2
  3114.         jb    OkayToMultiply
  3115.         mov    ax, fpacc.Mantissa [2]
  3116.         cmp    ax, PotTblN [bx] + 2
  3117.         ja    WhlLessLp2
  3118.         jb    OkayToMultiply
  3119.         mov    ax, fpacc.Mantissa [0]
  3120.         cmp    ax, PotTblN [bx]
  3121.         ja    WhlLessLp2
  3122. ;
  3123. ;
  3124. OkayToMultiply:    call    pTbl2FPOP
  3125.         mov    ax, PotTblN [bx] + 11    ;Adjust DecExponent
  3126.         add    DecExponent, ax
  3127.         call    sl_fMUL            ;Multiply by appropriate power.
  3128.         jmp    WhlLessThan1        ;Repeat till in range 1..10.
  3129. ;
  3130. ;
  3131. ; The above code tries to get fpacc in the range 1 <= n < 10.
  3132. ; However, it doesn't quite accomplish this.  In fact, it gets the value
  3133. ; into the range 1 <= n < 16.  This next section checks to see if the value
  3134. ; is greater than ten.  If it is, it does one more division by ten.
  3135. ;
  3136. NotLessThan1:    cmp    fpacc.Exponent, 8002h    ;10..15 only if exp = 8002h.
  3137.         jb    Not10_15
  3138. ;
  3139. ; For fpacc to be in the range 10..15 the mantissa must be greater than or
  3140. ; equal to 0A000 0000 0000 0000.
  3141. ;
  3142.         cmp    byte ptr fpacc.Mantissa [7], 0a0h
  3143.         jb    Not10_15
  3144. ;
  3145. ; Okay, the mantissa is greater than or equal to ten.  Divide by ten once
  3146. ; more to fix this up.
  3147. ;
  3148.         lea    bx, stdgrp:Div10Value
  3149.         sub    bx, offset stdgrp:PotTblN
  3150.         call    pTbl2FPOP
  3151.         call    sl_fMUL            ;Multiply by appropriate power.
  3152.         inc    DecExponent
  3153. ;
  3154. ; Well, we've managed to compute the decimal exponent value and normalize
  3155. ; the number to the range 1 <= n < 10.
  3156. ;
  3157. ; Make sure the upper four bits contain a BCD value.  This may entail
  3158. ; shifting data to the right.
  3159. ;
  3160. Not10_15:    mov    si, fpacc.Mantissa [0]    ;We'll use these a lot, so
  3161.         mov    di, fpacc.Mantissa [2]    ; put them into registers.
  3162.         mov    cx, fpacc.Mantissa [4]
  3163.         mov    dx, fpacc.Mantissa [6]
  3164. SHRLp:        cmp    fpacc.Exponent, 8002h
  3165.         jae    PossiblyRound
  3166.         shr    dx, 1
  3167.         rcr    cx, 1
  3168.         rcr    di, 1
  3169.         rcr    si, 1
  3170.         inc    fpacc.Exponent
  3171.         jmp     SHRLp
  3172. ;
  3173. ; May have to round the number if we wound up with a value between 10..15.
  3174. ;
  3175. ; Note: 0.5 e -18 is 7fc5 b8xxxxxxxx...   If we adjust this value so that
  3176. ;    the exponent is 7fffh, we keep only the top five bits (10111).  The
  3177. ;    following code adds this value (17h) to the mantiss to round as
  3178. ;    appropriate.
  3179. ;
  3180. PossiblyRound:    add    si, 2h
  3181.         jnc    ChkTooBig
  3182.         inc    di
  3183.         jnz    ChkTooBig
  3184.         inc    cx
  3185.         jnz    ChkTooBig
  3186.         inc    dx
  3187. ;
  3188. ; If we fall through to this point, it's quite possible that we will produce
  3189. ; a value greater than or equal to ten.  Handle that possibility here.
  3190. ;
  3191. ChkTooBig:    cmp    dh, 0a0h
  3192.         jb    NoOvrflw
  3193. ;
  3194. ; Well, overflow occurred, clean it up.
  3195. ;
  3196.         xor    ax, ax
  3197.         mov    si, ax
  3198.         mov    di, ax
  3199.         mov    cx, ax
  3200.         mov    dx, 1000h
  3201.         inc    DecExponent
  3202. ;
  3203. ; Finally!  We're at the point where we can start stripping off the
  3204. ; digits from the number
  3205. ;
  3206. NoOvrflw:    lea    bx, stdgrp:DecDigits
  3207.         xor    ax, ax
  3208. ;
  3209. StripDigits:    mov    al, dh
  3210.         shr    ax, 1
  3211.         shr    ax, 1
  3212.         shr     ax, 1
  3213.         shr    ax, 1
  3214.         or    al, '0'
  3215.         mov    [bx], al
  3216.         inc    bx
  3217.         cmp    bx, offset stdgrp:DecDigits+18
  3218.         jae    fpdDone
  3219. ;
  3220. ; Remove the digit we just stripped:
  3221. ;
  3222.         and    dh, 0fh
  3223. ;
  3224. ; Multiply the mantissa by ten (using shifts and adds):
  3225. ;
  3226.         shl    si, 1
  3227.         rcl    di, 1
  3228.         rcl    cx, 1
  3229.         rcl    dx, 1
  3230.         mov    fpacc.Mantissa [0], si    ;Save *2
  3231.         mov    fpacc.Mantissa [2], di
  3232.         mov    fpacc.Mantissa [4], cx
  3233.         mov    fpacc.Mantissa [6], dx
  3234. ;
  3235.         shl    si, 1            ;*4
  3236.         rcl    di, 1
  3237.         rcl    cx, 1
  3238.         rcl    dx, 1
  3239. ;
  3240.         shl    si, 1            ;*8
  3241.         rcl    di, 1
  3242.         rcl    cx, 1
  3243.         rcl    dx, 1
  3244. ;
  3245.         add    si, fpacc.Mantissa [0]    ;*10
  3246.         adc    di, fpacc.Mantissa [2]
  3247.         adc    cx, fpacc.Mantissa [4]
  3248.         adc    dx, fpacc.Mantissa [6]
  3249.         jmp     StripDigits
  3250. ;
  3251. fpdDone:        pop    si
  3252.         pop    di
  3253.         pop    dx
  3254.         pop    cx
  3255.         pop    bx
  3256.         pop    ax
  3257.         pop    ds
  3258.         ret
  3259. FPDigits    endp
  3260. ;
  3261. ;
  3262. ;
  3263. ; nTbl2FPOP- BX is an index into PotTbln.  This routine fetches the entry
  3264. ;         at that index and copies it into FPOP.
  3265. ;
  3266. nTbl2FPOP    proc    near
  3267.         mov    ax, PotTbln [bx] + 8
  3268.         mov    fpop.Exponent, ax
  3269.         mov    ax, PotTbln [bx]
  3270.         mov    fpop.Mantissa [0], ax
  3271.         mov    ax, PotTbln [bx] + 2
  3272.         mov    fpop.Mantissa [2], ax
  3273.         mov    ax, PotTbln [bx] + 4
  3274.         mov    fpop.Mantissa [4], ax
  3275.         mov    ax, PotTbln [bx] + 6
  3276.         mov    fpop.Mantissa [6], ax
  3277.         mov    fpop.Sign, 0        ;All entries are positive.
  3278.         ret
  3279. nTbl2FPOP    endp
  3280. ;
  3281. ; pTbl2FPOP- Same as above except the data comes from PotTblP.
  3282. ;
  3283. pTbl2FPOP    proc    near
  3284.         mov    ax, PotTblp [bx] + 8
  3285.         cmp    ax, 7fffh
  3286.         jne    DoPTFPOP
  3287.         sub    bx, 13            ;Special case if we hit 1.0
  3288.         mov    ax, PotTblp [bx] + 8
  3289. ;
  3290. DoPTFPOP:    mov    fpop.Exponent, ax
  3291.         mov    ax, PotTblp [bx]
  3292.         mov    fpop.Mantissa [0], ax
  3293.         mov    ax, PotTblp [bx] + 2
  3294.         mov    fpop.Mantissa [2], ax
  3295.         mov    ax, PotTblp [bx] + 4
  3296.         mov    fpop.Mantissa [4], ax
  3297.         mov    ax, PotTblp [bx] + 6
  3298.         mov    fpop.Mantissa [6], ax
  3299.         mov    fpop.Sign, 0        ;All entries are positive.
  3300.         ret
  3301. pTbl2FPOP    endp
  3302. ;
  3303. ;
  3304. ;
  3305. ;
  3306. ;
  3307. ;----------------------------------------------------------------------------
  3308. ;           Text => Floating Point (Input) Conversion Routines
  3309. ;----------------------------------------------------------------------------
  3310. ;
  3311. ;
  3312. ; ATOF-        ES:DI points at a string containing (hopefully) a numeric
  3313. ;        value in floating point format.  This routine converts that
  3314. ;        value to a number and puts the result in fpacc.  Allowable
  3315. ;        strings are described by the following regular expression:
  3316. ;
  3317. ;        {" "}* {+ | -} ( ([0-9]+ {"." [0-9]*}) | ("." [0-9]+)}
  3318. ;                {(e | E) {+ | -} [0-9] {[0-9]*}}
  3319. ;
  3320. ; "{}" denote optional items.
  3321. ; "|"  denotes OR.
  3322. ; "()" groups items together.
  3323. ;
  3324. ;
  3325. shl64        macro
  3326.         shl    bx, 1
  3327.         rcl    cx, 1
  3328.         rcl    dx, 1
  3329.         rcl    si, 1
  3330.         endm
  3331. ;
  3332.         public    sl_ATOF
  3333. sl_ATOF        proc    far
  3334.         assume    ds:StdGrp, es:nothing
  3335. ;
  3336.         push    ds
  3337.         push    ax
  3338.         push    bx
  3339.         push    cx
  3340.         push    dx
  3341.         push    si
  3342.         push    di
  3343.         push    bp
  3344. ;
  3345.         mov    ax, StdGrp
  3346.         mov    ds, ax
  3347. ;
  3348. ;
  3349. ; First, skip any leading spaces:
  3350. ;
  3351.         mov    ah, " "
  3352. SkipBlanks:    mov    al, es:[di]
  3353.         inc    di
  3354.         cmp    al, ah
  3355.         je    SkipBlanks
  3356. ;
  3357. ; Check for + or -.
  3358. ;
  3359.         cmp    al, "-"
  3360.         jne    TryPlusSign
  3361.         mov    fpacc.Sign, 80h
  3362.         jmp    EatSignChar
  3363. ;
  3364. TryPlusSign:    mov    fpacc.Sign, 0        ;If not "-", then positive.
  3365.         cmp    al, "+"
  3366.         jne    NotASign
  3367. EatSignChar:    mov    al, es:[di]        ;Get char beyond sign
  3368.         inc    di
  3369. ;
  3370. ; Init some important local vars:
  3371. ; Note: BP contains the number of significant digits processed thus far.
  3372. ;
  3373. NotASign:    mov    DecExponent, 0
  3374.         xor    bx, bx            ;Init 64 bit result.
  3375.         mov    cx, bx
  3376.         mov    dx, bx
  3377.         mov    si, bx
  3378.         mov    bp, bx
  3379.         mov    ah, bh
  3380. ;
  3381. ; First, eliminate any leading zeros (which do not count as significant
  3382. ; digits):
  3383. ;
  3384. Eliminate0s:    cmp    al, "0"
  3385.         jne    EndOfZeros
  3386.         mov    al, es:[di]
  3387.         inc    di
  3388.         jmp    Eliminate0s
  3389. ;
  3390. ; When we reach the end of the leading zeros, first check for a decimal
  3391. ; point.  If the number is of the form "0---0.0000" we need to get rid
  3392. ; of the zeros after the decimal point and not count them as significant
  3393. ; digits.
  3394. ;
  3395. EndOfZeros:    cmp    al, "."
  3396.         jne    WhileDigits
  3397. ;
  3398. ; Okay, the number is of the form ".xxxxx".  Strip all zeros immediately
  3399. ; after the decimal point.
  3400. ;
  3401. Right0s:    mov    al, es:[di]
  3402.         inc    di
  3403.         cmp    al, "0"
  3404.         jne    FractionPart
  3405.         dec    DecExponent        ;Not significant digit, but
  3406.         jmp    Right0s            ; affects exponent.
  3407. ;
  3408. ;
  3409. ; If the number is of the form "yyy.xxxx" (where y <> 0) then process it
  3410. ; down here.
  3411. ;
  3412. WhileDigits:    sub    al, "0"
  3413.         cmp    al, 10
  3414.         jae    NotADigit
  3415. ;
  3416. ; See if we've processed more than 19 sigificant digits:
  3417. ;
  3418.         cmp    bp, 19            ;Too many significant digits?
  3419.         jae    DontMergeDig
  3420. ;
  3421. ; Multiply value in (si, dx, cx, bx) by ten:
  3422. ;
  3423.         shl64
  3424.         mov    fpacc.Mantissa [0], bx
  3425.         mov    fpacc.Mantissa [2], cx
  3426.         mov    fpacc.Mantissa [4], dx
  3427.         mov    fpacc.Mantissa [6], si
  3428.         shl64
  3429.         shl64
  3430.         add    bx, fpacc.Mantissa [0]
  3431.         adc    cx, fpacc.Mantissa [2]
  3432.         adc    dx, fpacc.Mantissa [4]
  3433.         adc    si, fpacc.Mantissa [6]
  3434. ;
  3435. ; Add in current digit:
  3436. ;
  3437.         add    bx, ax
  3438.         jnc     GetNextDig
  3439.         inc    cx
  3440.         jne    GetNextDig
  3441.         inc    dx
  3442.         jne    GetNextDig
  3443.         inc    si
  3444.         jmp    GetNextDig
  3445. ;
  3446. DontMergeDig:    inc    DecExponent
  3447. GetNextDig:    inc    bp            ;Yet another significant dig.
  3448.         mov    al, es:[di]
  3449.         inc    di
  3450.         jmp    WhileDigits
  3451. ;
  3452. ;
  3453. ; Check to see if there is a decimal point here:
  3454. ;
  3455. NotADigit:    cmp    al, "."-"0"
  3456.         jne    NotADecPt
  3457.         mov    al, es:[di]
  3458.         inc    di
  3459. ;
  3460. ; Okay, process the digits to the right of the decimal point here.
  3461. ;
  3462. FractionPart:    sub    al, "0"
  3463.         cmp    al, 10
  3464.         jae    NotADecPt
  3465. ;
  3466. ; See if we've processed more than 19 sigificant digits:
  3467. ;
  3468.         cmp    bp, 19            ;Too many significant digits?
  3469.         jae    DontMergeDig2
  3470. ;
  3471. ; Multiply value in (si, dx, cx, bx) by ten:
  3472. ;
  3473.         dec    DecExponent        ;Raise by a power of ten.
  3474.         shl64
  3475.         mov    fpacc.Mantissa [0], bx
  3476.         mov    fpacc.Mantissa [2], cx
  3477.         mov    fpacc.Mantissa [4], dx
  3478.         mov    fpacc.Mantissa [6], si
  3479.         shl64
  3480.         shl64
  3481.         add    bx, fpacc.Mantissa [0]
  3482.         adc    cx, fpacc.Mantissa [2]
  3483.         adc    dx, fpacc.Mantissa [4]
  3484.         adc    si, fpacc.Mantissa [6]
  3485. ;
  3486. ; Add in current digit:
  3487. ;
  3488.         add    bx, ax
  3489.         jnc     DontMergeDig2
  3490.         inc    cx
  3491.         jne    DontMergeDig2
  3492.         inc    dx
  3493.         jne    DontMergeDig2
  3494.         inc    si
  3495. ;
  3496. DontMergeDig2:    inc    bp            ;Yet another significant dig.
  3497.         mov    al, es:[di]
  3498.         inc    di
  3499.         jmp    FractionPart
  3500. ;
  3501. ; Process the exponent down here
  3502. ;
  3503. NotADecPt:    cmp    al, "e"-"0"
  3504.         je    IsExponent
  3505.         cmp    al, "E"-"0"
  3506.         jne    NormalizeInput
  3507. ;
  3508. ; Okay, we just saw the "E" character, now read in the exponent value
  3509. ; and add it into DecExponent.
  3510. ;
  3511. IsExponent:    mov    ExpSign, 0        ;Assume positive exponent.
  3512.         mov    al, es:[di]
  3513.         inc    di
  3514.         cmp    al, "+"
  3515.         je    EatExpSign
  3516.         cmp    al, "-"
  3517.         jne    ExpNotNeg
  3518.         mov    ExpSign, 1        ;Exponent is negative.
  3519. EatExpSign:    mov    al, es:[di]
  3520.         inc    di
  3521. ExpNotNeg:    xor    bp, bp
  3522. ExpDigits:      sub    al, '0'
  3523.         cmp    al, 10
  3524.         jae    EndOfExponent
  3525.         shl    bp, 1
  3526.         mov    TempExp, bp
  3527.         shl    bp, 1
  3528.         shl    bp, 1
  3529.         add    bp, TempExp
  3530.         add    bp, ax
  3531.         mov    al, es:[di]
  3532.         inc    di
  3533.         jmp    ExpDigits
  3534. ;
  3535. EndOfExponent:    cmp    ExpSign, 0
  3536.         je    PosExp
  3537.         neg    bp
  3538. PosExp:        add    DecExponent, bp
  3539. ;
  3540. ; Normalize the number here:
  3541. ;
  3542. NormalizeInput:    mov    ax, si            ;See if they entered zero.
  3543.         or    ax, bx
  3544.         or    ax, cx
  3545.         or    ax, dx
  3546.         jnz    ItsNotZero
  3547.         jmp    ItsZero
  3548. ;
  3549. ItsNotZero:    mov    ax, si
  3550.         mov    si, 7fffh+63        ;Exponent if already nrm'd.
  3551. NrmInp16:    or    ax, ax            ;See if we can shift 16 bits.
  3552.         jnz    NrmInp8
  3553.         mov    ax, dx
  3554.         mov    dx, cx
  3555.         mov    cx, bx
  3556.         xor    bx, bx
  3557.         sub    si, 16
  3558.         jmp    NrmInp16
  3559. ;
  3560. NrmInp8:    cmp    ah, 0
  3561.         jne    NrmInp1
  3562.         mov    ah, al
  3563.         mov    al, dh
  3564.         mov    dh, dl
  3565.         mov    dl, ch
  3566.         mov    ch, cl
  3567.         mov    cl, bh
  3568.         mov    bh, bl
  3569.         mov    bl, 0
  3570.         sub    si, 8
  3571. ;
  3572. NrmInp1:    cmp    ah, 80h
  3573.         jae    NrmDone
  3574.         shl    bx, 1
  3575.         rcl    cx, 1
  3576.         rcl    dx, 1
  3577.         rcl    ax, 1
  3578.         dec    si
  3579.         jmp    NrmInp1
  3580. ;
  3581. ; Okay, the number is normalized.  Now multiply by 10 the number of times
  3582. ; specified in DecExponent.  Obviously, this uses the power of ten tables
  3583. ; to speed up this operation (and make it more accurate).
  3584. ;
  3585. NrmDone:    mov    fpacc.Exponent, si    ;Save away the value so far.
  3586.         mov    fpacc.Mantissa [0], bx
  3587.         mov    fpacc.Mantissa [2], cx
  3588.         mov    fpacc.Mantissa [4], dx
  3589.         mov    fpacc.Mantissa [6], ax
  3590. ;
  3591.         mov    bx, -13            ;Index into POT table.
  3592.         mov    si, DecExponent
  3593.         or    si, si            ;See if negative
  3594.         js    NegExpLp
  3595. ;
  3596. ; Okay, the exponent is positive, handle that down here.
  3597. ;
  3598. PosExpLp:    add    bx, 13            ;Find the 1st power of ten
  3599.         cmp    si, PotTblP [bx] + 11    ; in the table which is
  3600.         jb    PosExpLp        ; just less than this guy.
  3601.         cmp    PotTblP [bx] + 8, 7fffh    ;Hit 1.0 yet?
  3602.         je    MulExpDone
  3603. ;
  3604.         sub    si, PotTblP [bx] + 11    ;Fix for the next time through.
  3605.         call    PTbl2FPOP        ;Load up current power of ten.
  3606.         call    sl_FMUL            ;Multiply by this guy.
  3607.         jmp    PosExpLp
  3608. ;
  3609. ;
  3610. ; Okay, the exponent is negative, handle that down here.
  3611. ;
  3612. NegExpLp:    add    bx, 13            ;Find the 1st power of ten
  3613.         cmp    si, PotTblN [bx] + 11    ; in the table which is
  3614.         jg    NegExpLp        ; just less than this guy.
  3615.         cmp    PotTblN [bx] + 8, 7fffh    ;Hit 1.0 yet?
  3616.         je    MulExpDone
  3617. ;
  3618.         sub    si, PotTblN [bx] + 11    ;Fix for the next time through.
  3619.         call    NTbl2FPOP        ;Load up current power of ten.
  3620.         call    sl_FMUL            ;Multiply by this guy.
  3621.         jmp    NegExpLp
  3622. ;
  3623. ; If the user entered zero, drop down here and zero out fpacc.
  3624. ;
  3625. ItsZero:    xor    ax, ax
  3626.         mov    fpacc.Exponent, ax
  3627.         mov    fpacc.Sign, al
  3628.         mov    fpacc.Mantissa [0], ax
  3629.         mov    fpacc.Mantissa [2], ax
  3630.         mov    fpacc.Mantissa [4], ax
  3631.         mov    fpacc.Mantissa [6], ax
  3632. ;
  3633. ; Round the result to produce a *halfway* decent number
  3634. ;
  3635. MulExpDone:     cmp    fpacc.Exponent, 0ffffh        ;Don't round if too big.
  3636.         je    atofDone
  3637.         shl    byte ptr fpacc.Mantissa, 1    ;Use L.O. bits as guard
  3638.         adc    byte ptr fpacc.Mantissa [1], 0    ; bits.
  3639.         jnc    atofDone
  3640.         inc    fpacc.Mantissa[2]
  3641.         jne    atofDone
  3642.         inc    fpacc.Mantissa[4]
  3643.         jne    atofDone
  3644.         inc    fpacc.Mantissa[6]
  3645.         jne    atofDone
  3646.         inc    fpacc.Exponent
  3647. ;
  3648. atofDone:    mov    byte ptr fpacc.Mantissa, 0
  3649.         pop    bp
  3650.         pop    di
  3651.         pop    si
  3652.         pop    dx
  3653.         pop    cx
  3654.         pop    bx
  3655.         pop    ax
  3656.         pop    ds
  3657.         ret
  3658. sl_ATOF        endp
  3659. ;
  3660. ;
  3661. stdlib        ends
  3662.         end
  3663.